diff options
Diffstat (limited to 'example')
63 files changed, 10597 insertions, 0 deletions
diff --git a/example/Makefile b/example/Makefile new file mode 100644 index 0000000..be32170 --- /dev/null +++ b/example/Makefile @@ -0,0 +1,63 @@ +EXPVERSION = 5.31 + +CC = gcc +CPLUSPLUS = g++ +CPLUSPLUSLIBDIR = -L/depot/gnu/arch/lib +CPLUSPLUSLIB = -lg++ + +CFLAGS = -g -I.. +LIBEXPECT = -L.. -lexpect$(EXPVERSION) + +LIBS = $(LIBEXPECT) -lm + +SCRIPTS = su2 noidle script.exp bonfield.exp + +all: chesslib chesslib2 chesslib++ + +# this can be compiled with either cc or gcc +chesslib: chesslib.o + $(CC) -g -o chesslib chesslib.o $(LIBS) + +# this can be compiled with either cc or gcc +chesslib2: chesslib2.o + $(CC) -g -o chesslib2 chesslib2.o $(LIBS) + +# this is compiled with c++ +chesslib++: chesslib++.o + $(CPLUSPLUS) -g -o chesslib++ chesslib++.o $(LIBS) \ + $(CPLUSPLUSLIBDIR) $(CPLUSPLUSLIB) + +chesslib++.o: chesslib++.c + $(CPLUSPLUS) -c $(CFLAGS) chesslib++.c + +unbuffer-standalone: unbuffer.o + $(CC) -g -o unbuffer-standalone unbuffer.o $(LIBS) + +printvars: printvars.o + $(CC) -o printvars printvars.o $(LIBS) + +ftplib: ftplib.o + $(CC) -g -o ftplib ftplib.o $(LIBS) + +match_max: match_max.o + $(CC) -g -o match_max match_max.o $(LIBS) + +jaj1: jaj1.o + $(CC) -g -o jaj1 jaj1.o $(LIBS) + +jaj2: jaj2.o + $(CC) -g -o jaj2 jaj2.o $(LIBS) + +# wrap up password-generation examples +passgen: + shar passgen.README tkpasswd mkpasswd mkpasswd.man > /tmp/passgen + +cleanup: + rm -f expect devtty exho dumb test.raw test.results test.tmp + +# copy some contributed scripts over to public-accessible directory +SCRIPTDIR = ~ftp/pub/expect/scripts +ftp: + rcp README.scripts durer:$(SCRIPTDIR)/README + rcp $(SCRIPTS) durer:$(SCRIPTDIR) + rsh durer ls -l $(SCRIPTDIR) diff --git a/example/README b/example/README new file mode 100644 index 0000000..77081be --- /dev/null +++ b/example/README @@ -0,0 +1,144 @@ +This file is example/README. It contains brief descriptions of the +examples in this directory. Also listed are scripts from the Expect +archive at ftp.cme.nist.gov (See Expect's README for how to retrieve +these from). You are welcome to send me additional scripts. A number +of Expect scripts are also available in the Tcl archive, available via +anonymous ftp at harbor.ecn.purdue.edu + +Note that on some systems, some of the scripts (notably kibitz and +dislocate) require that Expect be installed. (Merely compiling the +expect binary is not enough.) + +-------------------- +Expect scripts (See next section for example Tk scripts) +-------------------- +Entries marked with "m" have their own man page. +Entries marked with "a" live in the Expect archive (see above). + + archie - mails back response after talking to archie ftp-catalog. + m autoexpect - generate an Expect script from watching a session + autopasswd - runs passwd non-interactively for superuser. + a bc - Uses bc to do arbitrary precision math. + beer.exp - 99 Bottles of Beer On The Wall, Expect-style. + beer.exp.out - sample output from beer.exp (but you really have to + run it to see the timing aspect). + a bonfield.exp - solve Jim Bonfield's puzzle that won the 1991 Obfuscated + C Code contest. + carpal - warn about typing for too long without a break. + chess.exp - has two chess games play each other. + m cryptdir - encrypt all files in a directory. + m decryptdir - decrypt all files in a directory. + m dislocate - allow disconnection/reconnection to background processes. + dvorak - dvorak keyboard. + a eftp - ftp client with miscellaneous frills (also see rftp below). + expectd.proto - telnet daemon. + ftp-inband - does file transfer over telnet, rlogin, etc. + ftp-rfc - retrieve a DoD RFC from uunet via anonymous ftp. + ftp-talk-radio - gets "Internet Talk Radio" files from a host. + gethostbyaddr - translates internet address to name (with a higher + success rate than nslookup). Easier to use, too. + getpassck - test for presence of bug in getpass. + irsh - run interactive commands via rsh + m kibitz - lets two people control a program at the same time. + Lots of uses. I.e., You can help another person remotely. + Can run an editor and log a transcript of a conversation. + a libro-II - connect to Libro-II, the NIST library catalog. + lpunlock - unhangs a printer which says it is "waiting for lock". + a mirror_file - mirror a file from another ftp site, copying file only + if changed. + a mirror_dir - mirror a directory from another ftp site, copying only + files which have changed. + m multixterm - drive several xterms simultaneously. + m mkpasswd - generates good passwords, optionally runs passwd with them. + a mx - return any MX records for the given host. + a noidle - run a shell which avoids being 'autologged out'. + a pager.alpha - sends a message to a (Alpha brand) pager. + a pager.mercury - sends a message to a (Mercury brand) pager. + m passmass - sets passwd on many machines simultaneously. + passwd.html - form to change a login passwd + passwd.cgi - CGI script to respond to passwd.html form + passwdprompt - Prompt from stdin and echo *'s. + a ping-and-page - Ping list of hosts. If any down, page system admin. + read1char - read a single character for the shell, Perl, etc. + reprompt - like timed-read but reprompt after given amount of time. + rlogin-cwd - rlogin giving you same current working directory. + (Compare to telnet-cwd and xrlogin.) + robohunt - plays the game of hunt (from Berkeley). + It's more of a wild player than good, but amusing to watch. + Fun to throw against people who don't know about it. + rogue.exp - finds a good game of rogue. + rftp - recursive ftp (assumes UNIX-style ftpd at other end). + a s-key-rlogin - Automate rlogin (or telnet) using s/key + a scripttoggle - Like UNIX script command, but allow enabling/disabling + of recording. + a slip.shar - scripts to keep your SLIP link alive. + su.exp - start up an 'su' and run the argument. + telnet-cwd - telnet giving you same current working directory. + telnet-in-bg - put telnet (or any program) in bg, saving all remaining + output to a logfile. + a term-rlogin - run Term over rlogin. Good for traversing PPP/SLIP or + firewall rlogin connections. + a term-start - start up Term (a sophisticated UNIX-to-UNIX serial line + handler). + a timed-choice - offer user a timed choice of responses. + timed-read - a timed read for the shell, Perl, etc. Compare with + reprompt example. + m timed-run - run a program for only a given amount of time. + a try-phone-list - automate logging in to remote system, trying numbers + from a list until finding one that works. + m unbuffer - disables output buffering that normally occurs when + programs are redirected. + virterm - example of terminal emulation and expect operations on + character graphics using arrays (compare to term_expect + (below) which uses Tk widget). + vrfy - verifies an email address using SMTP/VRFY to remote site. + a waste-collection - Contact NIST service for hazardous waste pickup. + weather - retrieves weather forecasts. + m xkibitz - similar to kibitz but uses X Window System for handling + communication. Also, allows users to be added dynamically. + xrlogin - rlogin giving you same DISPLAY. (Compare to rlogin-cwd.) + +To run, for example, chess.exp, type: + + expect chess.exp + +If expect is installed and your system supports the #! magic you can +invoke it as: + + chess.exp + +Each of these examples necessarily depends upon other binaries in the +system. For example, chess.exp depends upon the "usual" UNIX chess +program being present. If any of these programs are different, +it may cause the associated script to misbehave. + +Please use the ".exp" extension on scripts that might otherwise have +names that could be confused with the real program, such as "rogue.exp". +Scripts that have unique names do not need the extension, such as "rftp". + +-------------------- +Sample Expectk scripts +-------------------- +Entries marked with "m" have their own man page. + + term_expect - template for doing expect operations on character + graphics. + m tknewsbiff - pops up a window (or plays sounds, etc) when news + arrives in selected newsgroups. + tkpasswd - Tk GUI for changing passwords. + tkterm - Tk terminal emulator in a Tk text widget. + xpstat - provide an X window front end to the xpilot game. + +-------------------- +Sample C and C++ programs that use the Expect library +-------------------- + + chesslib.c - same thing as chess.exp, but in C. + chesslib2.c - ditto, but uses popen and stream-style I/O. + chesslib++.c - ditto, but for C++. + m unbuffer.c - same as unbuffer example but standalone + +You may change the value of CC or CPLUSPLUS in the Makefile, to +compile under gcc or other compilers. However, you may have to edit +the lines defining where the libraries are. + diff --git a/example/archie b/example/archie new file mode 100755 index 0000000..0d5f43f --- /dev/null +++ b/example/archie @@ -0,0 +1,41 @@ +#!/bin/sh +# -*- tcl -*- +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh "$0" ${1+"$@"} + +package require Expect + +# archie + +# Log in to the archie ftp-catalog at McGill University, and mail back results +# Brian P. Fitzgerald +# Department of Mechanical Engineering +# Rensselaer Polytechnic Institute + +set CINTR \003 ;# ^C +set CSUSP \032 ;# ^Z + +set timeout -1 +spawn telnet quiche.cs.mcgill.ca + +expect_after eof exit ;# archie logs us out if too many people are logged in + +expect { + login: {send archie\r} + "unknown" {exit 1} + "unreachable" {exit 1} +} + +expect "archie>" {send "set pager\r"} +expect "archie>" {send "set maxhits 20\r"} +expect "archie>" {send "set term vt100\r"} +expect "archie>" {send "set sortby time\r"} +expect "archie>" { + send "set mailto [exec whoami]@[exec hostname].[exec domainname]\r" +} + +send_user "type ^C to exit, ^Z to suspend\n" +interact { + -reset $CSUSP {exec kill -STOP [pid]} + $CINTR {exit 0} +} diff --git a/example/autoexpect b/example/autoexpect new file mode 100755 index 0000000..35e57ce --- /dev/null +++ b/example/autoexpect @@ -0,0 +1,348 @@ +#!/bin/sh +# -*- tcl -*- +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh "$0" ${1+"$@"} + +package require Expect + +# Name: autoexpect - generate an Expect script from watching a session +# +# Description: +# +# Given a program name, autoexpect will run that program. Otherwise +# autoexpect will start a shell. Interact as desired. When done, exit +# the program or shell. Autoexpect will create a script that reproduces +# your interactions. By default, the script is named script.exp. +# See the man page for more info. +# +# Author: Don Libes, NIST +# Date: June 30 1995 +# Version: 1.4b + +set filename "script.exp" +set verbose 1 +set conservative 0 +set promptmode 0 +set option_keys "" + +proc check_for_following {type} { + 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 + set argv [lrange $argv 1 end] + switch -- $flag \ + "-c" { + set conservative 1 + } "-C" { + check_for_following character + lappend option_keys [lindex $argv 0] ctoggle + set argv [lrange $argv 1 end] + } "-p" { + set promptmode 1 + } "-P" { + check_for_following character + lappend option_keys [lindex $argv 0] ptoggle + set argv [lrange $argv 1 end] + } "-Q" { + check_for_following character + lappend option_keys [lindex $argv 0] quote + set argv [lrange $argv 1 end] + } "-f" { + check_for_following filename + set filename [lindex $argv 0] + set argv [lrange $argv 1 end] + } "-quiet" { + set verbose 0 + } default { + break + } +} + +############################################################# +# Variables Descriptions +############################################################# +# userbuf buffered characters from user +# procbuf buffered characters from process +# lastkey last key pressed by user +# if undefined, last key came from process +# echoing if the process is echoing +############################################################# + +# Handle a character that came from user input (i.e., the keyboard) +proc input {c} { + global userbuf lastkey + + send -- $c + append userbuf $lastkey + set lastkey $c +} + +# Handle a null character from the keyboard +proc input_null {} { + global lastkey userbuf procbuf echoing + + send -null + + if {$lastkey == ""} { + if {$echoing} { + sendcmd "$userbuf" + } + if {$procbuf != ""} { + expcmd "$procbuf" + } + } else { + sendcmd "$userbuf" + if {$echoing} { + expcmd "$procbuf" + sendcmd "$lastkey" + } + } + cmd "send -null" + set userbuf "" + set procbuf "" + set lastkey "" + set echoing 0 +} + +# Handle a character that came from the process +proc output {s} { + global lastkey procbuf userbuf echoing + + send_user -raw -- $s + + if {$lastkey == ""} { + if {!$echoing} { + append procbuf $s + } else { + sendcmd "$userbuf" + expcmd "$procbuf" + set echoing 0 + set userbuf "" + set procbuf $s + } + return + } + + regexp (.)(.*) $s dummy c tail + if {$c == $lastkey} { + if {$echoing} { + append userbuf $lastkey + set lastkey "" + } else { + if {$procbuf != ""} { + expcmd "$procbuf" + set procbuf "" + } + set echoing 1 + } + append procbuf $s + + if {[string length $tail]} { + sendcmd "$userbuf$lastkey" + set userbuf "" + set lastkey "" + set echoing 0 + } + } else { + if {!$echoing} { + expcmd "$procbuf" + } + sendcmd "$userbuf$lastkey" + set procbuf $s + set userbuf "" + set lastkey "" + set echoing 0 + } +} + +# rewrite raw strings so that can appear as source code but still reproduce +# themselves. +proc expand {s} { + regsub -all "\\\\" $s "\\\\\\\\" s + regsub -all "\r" $s "\\r" s + regsub -all "\"" $s "\\\"" s + regsub -all "\\\[" $s "\\\[" s + regsub -all "\\\]" $s "\\\]" s + regsub -all "\\\$" $s "\\\$" s + + return $s +} + +# generate an expect command +proc expcmd {s} { + global promptmode + + if {$promptmode} { + regexp ".*\[\r\n]+(.*)" $s dummy s + } + + cmd "expect -exact \"[expand $s]\"" +} + +# generate a send command +proc sendcmd {s} { + global send_style conservative + + if {$conservative} { + cmd "sleep .1" + } + + cmd "send$send_style -- \"[expand $s]\"" +} + +# generate any command +proc cmd {s} { + global fd + puts $fd "$s" +} + +proc verbose_send_user {s} { + global verbose + + if {$verbose} { + send_user -- $s + } +} + +proc ctoggle {} { + global conservative send_style + + if {$conservative} { + cmd "# conservative mode off - adding no delays" + verbose_send_user "conservative mode off\n" + set conservative 0 + set send_style "" + } else { + cmd "# prompt mode on - adding delays" + verbose_send_user "conservative mode on\n" + set conservative 1 + set send_style " -s" + } +} + +proc ptoggle {} { + global 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" + verbose_send_user "prompt mode on\n" + set promptmode 1 + } +} + +# quote the next character from the user +proc quote {} { + expect_user -re . + send -- $expect_out(buffer) +} + + +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] && ![file isdirectory $dir/expect]} { + set expectpath $dir + break + } +} + +cmd "#![set expectpath]/expect -f +# +# This Expect script was generated by autoexpect on [timestamp -format %c] +# Expect and autoexpect were both written by Don Libes, NIST." +cmd {# +# Note that autoexpect does not guarantee a working script. It +# necessarily has to guess about certain things. Two reasons a script +# might fail are: +# +# 1) timing - A surprising number of programs (rn, ksh, zsh, telnet, +# etc.) and devices discard or ignore keystrokes that arrive "too +# quickly" after prompts. If you find your new script hanging up at +# one spot, try adding a short sleep just before the previous send. +# Setting "force_conservative" to 1 (see below) makes Expect do this +# automatically - pausing briefly before sending each character. This +# pacifies every program I know of. The -c flag makes the script do +# this in the first place. The -C flag allows you to define a +# character to toggle this mode off and on. + +set force_conservative 0 ;# set to 1 to force conservative mode even if + ;# script wasn't run conservatively originally +if {$force_conservative} { + set send_slow {1 .1} + proc send {ignore arg} { + sleep .1 + exp_send -s -- $arg + } +} + +# +# 2) differing output - Some programs produce different output each time +# they run. The "date" command is an obvious example. Another is +# ftp, if it produces throughput statistics at the end of a file +# transfer. If this causes a problem, delete these patterns or replace +# them with wildcards. An alternative is to use the -p flag (for +# "prompt") which makes Expect only look for the last line of output +# (i.e., the prompt). The -P flag allows you to define a character to +# toggle this mode off and on. +# +# Read the man page for more info. +# +# -Don + +} + +cmd "set timeout -1" +if {$conservative} { + set send_style " -s" + cmd "set send_slow {1 .1}" +} else { + set send_style "" +} + +if {[llength $argv]>0} { + eval spawn -noecho $argv + cmd "spawn $argv" +} else { + spawn -noecho $env(SHELL) + cmd "spawn \$env(SHELL)" +} + +cmd "match_max 100000" + +set lastkey "" +set procbuf "" +set userbuf "" +set echoing 0 + +remove_nulls 0 + +eval interact $option_keys { + -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" diff --git a/example/autoexpect.man b/example/autoexpect.man new file mode 100644 index 0000000..45f24a4 --- /dev/null +++ b/example/autoexpect.man @@ -0,0 +1,207 @@ +.TH AUTOEXPECT 1 "30 June 1995" +.SH NAME +autoexpect \- generate an Expect script from watching a session +.SH SYNOPSIS +.B autoexpect +[ +.I args +] +[ +.I program args... +] +.br +.SH INTRODUCTION + +autoexpect watches you interacting with another program and creates an +Expect script that reproduces your interactions. For straightline +scripts, autoexpect saves substantial time over writing scripts by +hand. Even if you are an Expect expert, you will find it convenient +to use autoexpect to automate the more mindless parts of interactions. +It is much easier to cut/paste hunks of autoexpect scripts together +than to write them from scratch. And if you are a beginner, you may +be able to get away with learning nothing more about Expect than how +to call autoexpect. + +The simplest way to use autoexpect is to call it from the command line +with no arguments. For example: + + % autoexpect + +By default, autoexpect spawns a shell for you. Given a program name +and arguments, autoexpect spawns that program. For example: + + % autoexpect ftp ftp.cme.nist.gov + +Once your spawned program is running, interact normally. When you +have exited the shell (or program that you specified), autoexpect will +create a new script for you. By default, autoexpect writes the new +script to "script.exp". You can override this with the \-f flag +followed by a new script name. + +The following example runs "ftp ftp.cme.nist.gov" and stores the +resulting Expect script in the file "nist". +.nf + + % autoexpect \-f nist ftp ftp.cme.nist.gov + +.fi +It is important to understand that +autoexpect does not guarantee a working script because it necessarily +has to guess about certain things \- and occasionally it guesses wrong. +However, it is usually very easy to identify and fix these problems. +The typical problems are: +.RS +.TP 4 +\(bu +Timing. A surprisingly large number of programs (rn, ksh, zsh, +telnet, etc.) and devices (e.g., modems) ignore keystrokes that arrive +"too quickly" after prompts. If you find your new script hanging up +at one spot, try adding a short sleep just before the previous send. + +You can force this behavior throughout by overriding the variable +"force_conservative" near the beginning of the generated script. This +"conservative" mode makes autoexpect automatically pause briefly (one +tenth of a second) before sending each character. This pacifies every +program I know of. + +This conservative mode is useful if you just want to quickly reassure +yourself that the problem is a timing one (or if you really don't care +about how fast the script runs). This same mode can be forced before +script generation by using the \-c flag. + +Fortunately, these timing spots are rare. For example, telnet ignores +characters only after entering its escape sequence. Modems only +ignore characters immediately after connecting to them for the first +time. A few programs exhibit this behavior all the time but typically +have a switch to disable it. For example, rn's \-T flag disables this +behavior. + +The following example starts autoexpect in conservative +mode. +.nf + + autoexpect \-c + +.fi +The \-C flag defines a key to toggle conservative mode. +The following example starts autoexpect (in non-conservative +mode) with ^L as the toggle. (Note that the ^L is +entered literally - i.e., enter a real control-L). +.nf + + autoexpect \-C ^L + +.fi +The following example starts autoexpect in conservative +mode with ^L as the toggle. +.nf + + autoexpect \-c \-C ^L + +.fi +.TP +\(bu +Echoing. Many program echo characters. For example, if you type +"more" to a shell, what autoexpect actually sees is: +.nf + + you typed 'm', + computer typed 'm', + you typed 'o', + computer typed 'o', + you typed 'r', + computer typed 'r', + ... +.fi + +Without specific knowledge of the program, it is impossible to know if +you are waiting to see each character echoed before typing the next. +If autoexpect sees characters being echoed, it assumes that it can +send them all as a group rather than interleaving them the way they +originally appeared. This makes the script more pleasant to read. +However, it could conceivably be incorrect if you really had to wait +to see each character echoed. + +.TP +\(bu +Change. Autoexpect records every character from the interaction in +the script. This is desirable because it gives you the ability to +make judgements about what is important and what can be replaced with +a pattern match. + +On the other hand, if you use commands whose output differs from run +to run, the generated scripts are not going to be correct. For +example, the "date" command always produces different output. So +using the date command while running autoexpect is a sure way to +produce a script that will require editing in order for it to work. + +The \-p flag puts autoexpect into "prompt mode". In this mode, +autoexpect will only look for the the last line of program output \- +which is usually the prompt. This handles the date problem (see +above) and most others. + +The following example starts autoexpect in prompt mode. +.nf + + autoexpect \-p + +.fi +The \-P flag defines a key to toggle prompt mode. The following +example starts autoexpect (in non-prompt mode) with ^P as the toggle. +Note that the ^P is entered literally - i.e., enter a real control-P. +.nf + + autoexpect \-P ^P + +.fi +The following example starts autoexpect in prompt mode with ^P as the toggle. +.nf + + autoexpect \-p \-P ^P + +.fi +.SH OTHER FLAGS +The +.B \-quiet +flag disables informational messages produced by autoexpect. + +The +.B \-Q +flag names a quote character which can be used to enter characters +that autoexpect would otherwise consume because they are used as toggles. + +The following example shows a number of flags with quote used to +provide a way of entering the toggles literally. +.nf + + autoexpect \-P ^P \-C ^L \-Q ^Q + +.fi +.SH STYLE + +I don't know if there is a "style" for Expect programs but autoexpect +should definitely not be held up as any model of style. For example, +autoexpect uses features of Expect that are intended specifically for +computer-generated scripting. So don't try to faithfully write +scripts that appear as if they were generated by autoexpect. This is +not useful. + +On the other hand, autoexpect scripts do show some worthwhile things. +For example, you can see how any string must be quoted in order to use +it in a Tcl script simply by running the strings through autoexpect. + +.SH SEE ALSO +.I +"Exploring Expect: A Tcl-Based Toolkit for Automating Interactive Programs" +\fRby Don Libes, +O'Reilly and Associates, January 1995. +.SH AUTHOR +Don Libes, National Institute of Standards and Technology + +.B expect +and +.B autoexpect +are in the public domain. +NIST and I would +appreciate credit if these programs or parts of them are used. + diff --git a/example/autopasswd b/example/autopasswd new file mode 100755 index 0000000..1d095e2 --- /dev/null +++ b/example/autopasswd @@ -0,0 +1,17 @@ +#!/bin/sh +# -*- tcl -*- +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh "$0" ${1+"$@"} + +package require Expect + +# wrapper to make passwd(1) be non-interactive +# username is passed as 1st arg, passwd as 2nd + +set password [lindex $argv 1] +spawn passwd [lindex $argv 0] +expect "assword:" +send -- "$password\r" +expect "assword:" +send -- "$password\r" +expect eof diff --git a/example/beer.exp b/example/beer.exp new file mode 100755 index 0000000..1fcb86b --- /dev/null +++ b/example/beer.exp @@ -0,0 +1,116 @@ +#!/depot/path/expect -f + +# 99 bottles of beer on the wall, Expect-style +# Author: Don Libes <libes@nist.gov> + +# Unlike programs (http://www.ionet.net/~timtroyr/funhouse/beer.html) +# which merely print out the 99 verses, this one SIMULATES a human +# typing the beer song. Like a real human, typing mistakes and timing +# becomes more erratic with each beer - the final verse is barely +# recognizable and it is really like watching a typist hunt and peck +# while drunk. + +# Finally, no humans actually sing all 99 verses - particularly when +# drunk. In reality, they occasionally lose their place (or just get +# bored) and skip verses, so this program does likewise. + +# Because the output is timed, just looking at the output isn't enough +# - you really have to see the program running to appreciate it. +# Nonetheless, for convenience, output from one run (it's different +# every time of course) can be found in the file beer.exp.out +# But it won't show the erratic timing; you have to run it for that. + +# For an even fancier version, see http://expect.nist.gov/scripts/superbeer.exp + +proc bottles {i} { + return "$i bottle[expr {$i!=1?"s":""}] of beer" +} + +proc line123 {i} { + out $i "[bottles $i] on the wall,\n" + out $i "[bottles $i],\n" + out $i "take one down, pass it around,\n" +} + +proc line4 {i} { + out $i "[bottles $i] on the wall.\n\n" +} + +proc out {i s} { + foreach c [split $s ""] { + # don't touch punctuation; just looks too strange if you do + if {[regexp "\[,. \n\]" $c]} { + append d $c + continue + } + + # keep first couple of verses straight + if {$i > 97} {append d $c; continue} + + # +3 prevents it from degenerating too far + # /2 makes it degenerate faster though + + set r [rand [expr {$i/2+3}]] + if {$r} {append d $c; continue} + + # do something strange + switch [rand 3] { + 0 { + # substitute another letter + + if {[regexp \[aeiou\] $c]} { + # if vowel, substitute another + append d [string index aeiou [rand 5]] + } 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]] + } + } 1 { + # duplicate a letter + append d $c$c + } 2 { + # drop a letter + } + } + } + + set arr1 [expr {.4 - ($i/333.)}] + set arr2 [expr {.6 - ($i/333.)}] + set shape [expr {log(($i+2)/2.)+.1}] + set min 0 + set max [expr {6-$i/20.}] + + set send_human "$arr1 $arr2 $shape $min $max" + + send -h $d +} + +set _ran [pid] + +proc rand {m} { + global _ran + + set period 259200 + set _ran [expr {($_ran*7141 + 54773) % $period}] + expr {int($m*($_ran/double($period)))} +} + +for {set i 99} {$i>0} {} { + line123 $i + incr i -1 + line4 $i + + # get bored and skip ahead + if {$i == 92} { + set i [expr {52+[rand 5]}] + } + if {$i == 51} { + set i [expr {12+[rand 5]}] + } + if {$i == 10} { + set i [expr {6+[rand 3]}] + } +} diff --git a/example/beer.exp.out b/example/beer.exp.out new file mode 100644 index 0000000..768e58e --- /dev/null +++ b/example/beer.exp.out @@ -0,0 +1,119 @@ +99 bottles of beer on the wall, +99 bottles of beer, +take one down, pass it around, +98 bottles of beer on the wall. + +98 bottles of beer on the wall, +98 bottles of beer, +take one down, pass it around, +97 bottles of beer on the wall. + +97 bottles of beer on the wadl, +97 bottles of beer, +take one down, pass it around, +96 bottles of beer on the wall. + +96 bottlees of beer on the wall, +96 bowtles of beer, +take one down, piss it around, +95 bottles of beer on the salll. + +95 bottles of ber on the wall, +95 qottles of beer, +take one down, pass it around, +94 bottles of beeer on the wall. + +94 ottles ef beer on the wall, +94 bottles of beer, +take one down, pass it around, +93 bottles of beer n the wall. + +93 bottles of beer on the wall, +93 bottles of beer, +take one sown, pass it ajound, +92 bottles of beer on the wall. + +56 bottles of beer on the wwall, +56 bottles of beer, +ake ne down, pass it around, +55 bottles oof beer on the wall. + +55 bottles of beer on the wall, +55 bottles if beer, +take one down, pass it around, +54 bottles of beer on the wall. + +54 bottles of beer on the wall, +54 bottles of beer, +take one dow, bass it around, +53 bottes of beer on the wall. + +53 bottlef of beer on the wall, +53 bottles of beer, +tke one down, pas t around, +52 bottles of beer on the wall. + +52 bottless o beer on the wall, +52 botttles of beer, +take one down, pass it round, +51 bottles of beer on the all. + +114 bottles of ber on the wall, +14 botles of ber, +taakee one ddown, pass it around, +13 bottles of beeer on the wakl. + +13 bottles of beer on tth wall, +1 yottles of beer, +take one down, xass it around, +12 botles ooff beer on the walll. + +12 bottttqes of beer oon the wall, +12 bttles oof beer, +take one down, pass it around, +11 boottles of beer on the wall. + +11 botttles of beer on the all, +1 otttles of beer, +tae one duwn, ppess it around, +10 bottlos of beer on the wall. + +8 bottles of beer on thee wwall, +8 bottles oof eer, +taxe onne doown, pass iz aaroind, +77 botttles f beer on nhe wall. + +7 bbottes of beer on the wlll, +7 bomtles of beer, +ake onee dwn, pass it around, +6 bottles of beer on the ral. + +6 botttles of berr on the wal, +6 bottles oof beer, +take onee donn, pas it arouund, +5 bottles of beer oq the wall. + + bottles f beer on the walll, +5 botttlees of meer, +take one down, passs it aroundd, +4 boothles of beer n thhe wall. + +6 botyles of boer n the lll, +4 bottles i beer, +take one down, pass i aarounnd, +3 bbotlos of bbeir iy te wall. + + bottles off ee on the wall, +3 buttes of bbeer, +take one dooxn, pass il rround, +3 bottles oof ber on tthe wall. + +2 bottle uf er ooc the tall, +2 bettles ok beear, +taka onu doowy, pesss itt arond, +1 botjllee off beer i thh walll. + +11 botqle off baer oc tbe wakl, +1 botplo of beer, +take onne da, pass itt arounm, +0 yotglees oof beeeer on tte walll. diff --git a/example/carpal b/example/carpal new file mode 100644 index 0000000..4e8840f --- /dev/null +++ b/example/carpal @@ -0,0 +1,26 @@ +# Script to enforce a 10 minute break every half hour from typing - +# Written for someone (Uwe Hollerbach) with Carpal Tunnel Syndrome. + +# If you type for more than 20 minutes straight, the script rings +# the bell after every character until you take a 10 minute break. + +# Author: Don Libes, NIST +# Date: Feb 26, '95 + +spawn $env(SHELL) +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 [clock seconds] + + if {$now-$stop > $notyping} { + set start [clock seconds] + } elseif {$now-$start > $typing} { + send_user "\007" + } + set stop [clock seconds] +} diff --git a/example/chess.exp b/example/chess.exp new file mode 100755 index 0000000..7cbd8ff --- /dev/null +++ b/example/chess.exp @@ -0,0 +1,59 @@ +#!/bin/sh +# -*- tcl -*- +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh "$0" ${1+"$@"} + +package require Expect + + +# expect script to connect two UNIX chess programs together. +# written by Don Libes - May 9, 1990 + +# Note, this depends on the "usual" UNIX chess output. Other chess programs +# will almost certainly not work. + +# Moves and counter-moves are printed out in different formats, sigh... +# But I guess that's what makes this Expect script challenging to write. +# In particular, the 1st player outputs: +# +# p/k2-k4 (echo from 2nd player) +# 1. ... p/k2-k4 (reprint it with a number in front - god knows why) +# 2. n/kn1-kb3 (our new move) +# +# and the 2nd player outputs the following +# +# n/kn1-kb3 (echo from first player) +# 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 + } +} + +# start things rolling +spawn chess +set id1 $spawn_id +expect "Chess\r\n" +send "first\r" +# read_first_move +expect -re "1. (.*)\n" + +spawn chess +set id2 $spawn_id +expect "Chess\r\n" +send $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) + } + } +} diff --git a/example/chesslib++.c b/example/chesslib++.c new file mode 100644 index 0000000..0742de1 --- /dev/null +++ b/example/chesslib++.c @@ -0,0 +1,87 @@ +/* testlib.c for c++ - test expectlib */ + +#include <stdio.h> +#include "expect.h" + +extern "C" { + extern int write(...); + extern int strlen(...); +} + +void +timedout() +{ + fprintf(stderr,"timed out\n"); + exit(-1); +} + +char move[100]; + +void +read_first_move(int fd) +{ + if (EXP_TIMEOUT == exp_expectl(fd,exp_glob,"first\r\n1.*\r\n",0,exp_end)) { + timedout(); + } + sscanf(exp_match,"%*s 1. %s",move); +} + +/* moves and counter-moves are printed out in different formats, sigh... */ + +void +read_counter_move(int fd) +{ + switch (exp_expectl(fd,exp_glob,"*...*\r\n",0,exp_end)) { + case EXP_TIMEOUT: timedout(); + case EXP_EOF: exit(-1); + } + + sscanf(exp_match,"%*s %*s %*s %*s ... %s",move); +} + +void +read_move(int fd) +{ + switch (exp_expectl(fd,exp_glob,"*...*\r\n*.*\r\n",0,exp_end)) { + case EXP_TIMEOUT: timedout(); + case EXP_EOF: exit(-1); + } + + sscanf(exp_match,"%*s %*s ... %*s %*s %s",move); +} + +void +send_move(int fd) +{ + write(fd,move,strlen(move)); +} + +main(){ + int fd1, fd2; + + exp_loguser = 1; + exp_timeout = 3600; + + 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; + + read_first_move(fd1); + + fd2 = exp_spawnl("chess","chess",(char *)0); + + if (-1 == exp_expectl(fd2,exp_glob,"Chess\r\n",0,exp_end)) exit; + + for (;;) { + send_move(fd2); + read_counter_move(fd2); + + send_move(fd1); + read_move(fd1); + } +} diff --git a/example/chesslib.c b/example/chesslib.c new file mode 100644 index 0000000..f81fa4d --- /dev/null +++ b/example/chesslib.c @@ -0,0 +1,83 @@ +/* chesslib.c - test expectlib */ + +#include <stdio.h> +#include "expect.h" + +timedout() +{ + fprintf(stderr,"timed out\n"); + exit(-1); +} + +char move[100]; + +read_first_move(fd) +int fd; +{ + if (EXP_TIMEOUT == exp_expectl(fd, + exp_glob,"first\r\n1.*\r\n",0, + exp_end)) { + timedout(); + } + sscanf(exp_match,"%*s 1. %s",move); +} + +/* moves and counter-moves are printed out in different formats, sigh... */ + +read_counter_move(fd) +int fd; +{ + switch (exp_expectl(fd,exp_glob,"*...*\r\n",0,exp_end)) { + case EXP_TIMEOUT: timedout(); + case EXP_EOF: exit(-1); + } + + sscanf(exp_match,"%*s %*s %*s %*s ... %s",move); +} + +read_move(fd) +int fd; +{ + switch (exp_expectl(fd,exp_glob,"*...*\r\n*.*\r\n",0,exp_end)) { + case EXP_TIMEOUT: timedout(); + case EXP_EOF: exit(-1); + } + + sscanf(exp_match,"%*s %*s ... %*s %*s %s",move); +} + +send_move(fd) +int fd; +{ + write(fd,move,strlen(move)); +} + +main(){ + int fd1, fd2; + + exp_loguser = 1; + exp_timeout = 3600; + + 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; + + read_first_move(fd1); + + fd2 = exp_spawnl("chess","chess",(char *)0); + + if (-1 == exp_expectl(fd2,exp_glob,"Chess\r\n",0,exp_end)) exit; + + for (;;) { + send_move(fd2); + read_counter_move(fd2); + + send_move(fd1); + read_move(fd1); + } +} diff --git a/example/chesslib2.c b/example/chesslib2.c new file mode 100644 index 0000000..00aed25 --- /dev/null +++ b/example/chesslib2.c @@ -0,0 +1,84 @@ +/* testlib.c - test expectlib */ + +#include <stdio.h> +#include "expect.h" + +timedout() +{ + fprintf(stderr,"timed out\n"); + exit(-1); +} + +char move[100]; + +read_first_move(fp) +FILE *fp; +{ + if (EXP_TIMEOUT == exp_fexpectl(fp, + exp_glob,"first\r\n1.*\r\n",0, + exp_end)) { + timedout(); + } + sscanf(exp_match,"%*s 1. %s",move); +} + +/* moves and counter-moves are printed out in different formats, sigh... */ + +read_counter_move(fp) +FILE *fp; +{ + switch (exp_fexpectl(fp,exp_glob,"*...*\r\n",0, exp_end)) { + case EXP_TIMEOUT: timedout(); + case EXP_EOF: exit(-1); + } + + sscanf(exp_match,"%*s %*s %*s %*s ... %s",move); +} + +read_move(fp) +FILE *fp; +{ + switch (exp_fexpectl(fp,exp_glob,"*...*\r\n*.*\r\n",0,exp_end)) { + case EXP_TIMEOUT: timedout(); + case EXP_EOF: exit(-1); + } + + sscanf(exp_match,"%*s %*s ... %*s %*s %s",move); +} + +send_move(fp) +FILE *fp; +{ + fprintf(fp,move); +} + +main(){ + FILE *fp1, *fp2; + int ec; + +/* exp_is_debugging = 1;*/ + exp_loguser = 1; + exp_timeout = 3600; + + if (0 == (fp1 = exp_popen("chess"))) { + perror("chess"); + exit(-1); + } + + if (0 > exp_fexpectl(fp1,exp_glob,"Chess\r\n",0,exp_end)) exit(-1); + fprintf(fp1,"first\r"); + + read_first_move(fp1); + + fp2 = exp_popen("chess"); + + exp_fexpectl(fp2,exp_glob,"Chess\r\n",0,exp_end); + + for (;;) { + send_move(fp2); + read_counter_move(fp2); + + send_move(fp1); + read_move(fp1); + } +} diff --git a/example/cryptdir b/example/cryptdir new file mode 100755 index 0000000..84a155b --- /dev/null +++ b/example/cryptdir @@ -0,0 +1,68 @@ +#!/bin/sh +# -*- tcl -*- +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh "$0" ${1+"$@"} + +package require Expect + + +# Name: cryptdir +# Author: Don Libes, NIST +# +# Synopsis: +# cryptdir [dir] +# decryptdir [dir] +# +# Encrypt or decrypts the current directory or named directory if given. + +if {[llength $argv] > 0} { + cd $argv +} + +# encrypt or decrypt? +set decrypt [regexp "decrypt" $argv0] + +set timeout -1 +stty -echo +send "Password:" +expect -re "(.*)\n" +send "\n" +set passwd $expect_out(1,string) + +# 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 "." +} +send_tty "\n" diff --git a/example/cryptdir.man b/example/cryptdir.man new file mode 100644 index 0000000..01fbdb2 --- /dev/null +++ b/example/cryptdir.man @@ -0,0 +1,42 @@ +.TH CRYPTDIR 1 "1 January 1993" +.SH NAME +cryptdir \- encrypt/decrypt all files in a directory +.SH SYNOPSIS +.B cryptdir +[ +.I dir +] +.br +.B decryptdir +[ +.I dir +] +.SH INTRODUCTION +.B cryptdir +encrypts all files in the current directory (or the given directory +if one is provided as an argument). When called as decryptdir +(i.e., same program, different name), all files are decrypted. + +.SH NOTES +When encrypting, you are prompted twice for the password as a +precautionary measure. It would be a disaster to encrypt files with a +password that wasn't what you intended. + +In contrast, when decrypting, you are only prompted once. If it's the +wrong password, no harm done. + +Encrypted files have the suffix .crypt appended. This prevents files +from being encrypted twice. The suffix is removed upon decryption. +Thus, you can easily add files to an encrypted directory and run +cryptdir on it without worrying about the already encrypted files. +.SH BUGS + +The man page is longer than the program. + +.SH SEE ALSO +.I +"Exploring Expect: A Tcl-Based Toolkit for Automating Interactive Programs" +\fRby Don Libes, +O'Reilly and Associates, January 1995. +.SH AUTHOR +Don Libes, National Institute of Standards and Technology diff --git a/example/decryptdir b/example/decryptdir new file mode 100755 index 0000000..84a155b --- /dev/null +++ b/example/decryptdir @@ -0,0 +1,68 @@ +#!/bin/sh +# -*- tcl -*- +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh "$0" ${1+"$@"} + +package require Expect + + +# Name: cryptdir +# Author: Don Libes, NIST +# +# Synopsis: +# cryptdir [dir] +# decryptdir [dir] +# +# Encrypt or decrypts the current directory or named directory if given. + +if {[llength $argv] > 0} { + cd $argv +} + +# encrypt or decrypt? +set decrypt [regexp "decrypt" $argv0] + +set timeout -1 +stty -echo +send "Password:" +expect -re "(.*)\n" +send "\n" +set passwd $expect_out(1,string) + +# 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 "." +} +send_tty "\n" diff --git a/example/decryptdir.man b/example/decryptdir.man new file mode 100644 index 0000000..683cb7a --- /dev/null +++ b/example/decryptdir.man @@ -0,0 +1,42 @@ +.TH CRYPTDIR 1 "1 January 1993" +.SH NAME +cryptdir \- encrypt/decrypt all files in a directory +.SH SYNOPSIS +.B cryptdir +[ +.I dir +] +.br +.B decryptdir +[ +.I dir +] +.SH INTRODUCTION +.B cryptdir +encrypts all files in the current directory (or the given directory +if one is provided as an argument). When called as decryptdir +(i.e., same program, different name), all files are decrypted. + +.SH NOTES +When encrypting, you are prompted twice for the password as a +precautionary measure. It would be a disaster to encrypt files a +password that wasn't what you intended. + +In contrast, when decrypting, you are only prompted once. If it's the +wrong password, no harm done. + +Encrypted files have the suffix .crypt appended. This prevents files +from being encrypted twice. The suffix is removed upon decryption. +Thus, you can easily add files to an encrypted directory and run +cryptdir on it without worrying about the already encrypted files. +.SH BUGS + +The man page is longer than the program. + +.SH SEE ALSO +.I +"Exploring Expect: A Tcl-Based Toolkit for Automating Interactive Programs" +\fRby Don Libes, +O'Reilly and Associates, January 1995. +.SH AUTHOR +Don Libes, National Institute of Standards and Technology diff --git a/example/dislocate b/example/dislocate new file mode 100755 index 0000000..9d34180 --- /dev/null +++ b/example/dislocate @@ -0,0 +1,355 @@ +#!/bin/sh +# -*- tcl -*- +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh "$0" ${1+"$@"} + +package require Expect + + +# dislocate - allow disconnection and reconnection to a background program +# Author: Don Libes, NIST + +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" +} else { + 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" + +set escape \035 ;# control-right-bracket +set escape_printable "^\]" + +set pidfile "~/.dislocate" +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 + } +} + +# 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} { + return "/tmp/$::prefix$pid$::infifosuffix" +} + +proc outfifoname {pid} { + return "/tmp/$::prefix$pid$::outfifosuffix" +} + +proc pid_remove {pid} { + say "removing $pid $::proc($pid)" + + unset ::date($pid) + unset ::proc($pid) +} + +# 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 + + 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 +} + +proc fifo_pair_remove {pid} { + global date proc prefix + + pidfile_read + pid_remove $pid + pidfile_write + + 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] +} + +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 +} + +proc child {argdate argv} { + 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 -eof exit + puts "returning ..." +} + +# interactively query user to choose process, return pid +proc choose {} { + 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 [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] + } +} + +say "opening [outfifoname $pid] for write" +spawn -noecho -open [open [outfifoname $pid] w] +set out $spawn_id + +say "opening [infifoname $pid] for read" +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 {} { + return "$::argv0[history nextid]> " +} + +rename exit exitReal + +proc exit {} { + exec /bin/kill $::catpid + exitReal +} + +interact { + -reset $escape escape + -output $out + -input $in +} + + diff --git a/example/dislocate.man b/example/dislocate.man new file mode 100644 index 0000000..e12b35c --- /dev/null +++ b/example/dislocate.man @@ -0,0 +1,100 @@ +.TH DISLOCATE 1 "7 October 1993" +.SH NAME +Dislocate \- disconnect and reconnect processes +.SH SYNOPSIS +.B dislocate +[ +.I program args... +] +.SH INTRODUCTION +.B Dislocate +allows processes to be disconnected and reconnected to the terminal. +Possible uses: +.RS +.TP 4 +\(bu +You can disconnect a process from a terminal at work +and reconnect from home, to continue working. +.TP 4 +\(bu +After having your line be dropped due to noise, you can get back to your +process without having to restart it from scratch. +.TP 4 +\(bu +If you have a problem that you would like to show someone, you can set +up the scenario at your own terminal, disconnect, walk down the hall, +and reconnect on another terminal. +.TP 4 +\(bu +If you are in the middle of a great game (or whatever) that does not allow +you to save, and someone else kicks you off the terminal, you can disconnect, +and reconnect later. +.SH USAGE +When run with no arguments, +.B Dislocate +tells you about your disconnected processes and lets you reconnect to one. +Otherwise, +.B Dislocate +runs the named program along with any arguments. + +By default, ^] is an escape that lets you talk to +.B Dislocate +itself. At that point, you can disconnect (by pressing ^D) or +suspend +.B Dislocate +(by pressing ^Z). + +Any Tcl or Expect command is also acceptable at this point. +For example, +to insert the contents of a the file /etc/motd as if you had typed it, say: +.nf + + send -i $out [exec cat /etc/motd] + +.fi + +To send the numbers 1 to 100 in response to the prompt "next #", say: +.nf + + for {set i 0} {$i<100} {incr i} { + expect -i $in "next #" + send -i $out "$i\\r" + } +.fi + +Scripts can also be prepared and sourced in so that you don't have to +type them on the spot. + +.B Dislocate +is actually just a simple +.B Expect +script. Feel free to make it do what you want it to do or just +use +.B Expect +directly, without going through +.BR Dislocate . +.B Dislocate +understands a few special arguments. These should appear before any program +name. Each should be separated by whitespace. If the arguments themselves +takes arguments, these should also be separated by whitespace. +.PP +The +.B \-escape +flag sets the escape to whatever follows. The default escape is ^]. +.PP +.SH CAVEATS +This program was written by the author as an exercise to show that +communicating with disconnected processes is easy. There are +many features that could be added, but that is not the intent of this +program. + +.SH SEE ALSO +.BR Tcl (3), +.BR libexpect (3) +.br +.I +"Exploring Expect: A Tcl-Based Toolkit for Automating Interactive Programs" +\fRby Don Libes, +O'Reilly and Associates, January 1995. +.SH AUTHOR +Don Libes, National Institute of Standards and Technology diff --git a/example/dvorak b/example/dvorak new file mode 100755 index 0000000..b5debc3 --- /dev/null +++ b/example/dvorak @@ -0,0 +1,36 @@ +#!/bin/sh +# -*- tcl -*- +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh "$0" ${1+"$@"} + +package require Expect + + +# simulate a dvorak keyboard +# Actually just the lowercase letters are mapped to show the basic idea. +# Really, uppercase and control should probably be mapped too. +# But this isn't really what expect is all about. It just demonstrates +# the mapping ability of 'interact'. + +proc rot {} { + interact { + q {send '} w {send ,} e {send .} r {send p} + t {send y} y {send f} u {send g} i {send c} + o {send r} p {send l} s {send o} d {send e} + f {send u} g {send i} h {send d} j {send h} + k {send t} l {send n} \; {send s} ' {send -- -} + z {send \;} x {send q} c {send j} v {send k} + b {send x} n {send b} , {send w} . {send v} + / {send z} ~q {return} ~d {} ~e {} + -o eof exit + } +} + +log_user 0 +spawn $env(SHELL) +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 {interpreter -eof exit} diff --git a/example/expectd.proto b/example/expectd.proto new file mode 100644 index 0000000..a26ca80 --- /dev/null +++ b/example/expectd.proto @@ -0,0 +1,80 @@ +#!/depot/tcl/src/expect/e -- +# Description: Simple fragment to begin a telnet daemon +# For more information, see Chapter 17 of "Exploring Expect" +# Author: Don Libes, NIST + +set IAC "\xff" +set DONT "\xfe" +set DO "\xfd" +set WONT "\xfc" +set WILL "\xfb" +set SB "\xfa" ;# subnegotation begin +set SE "\xf0" ;# subnegotation end +set TTYPE "\x18" +set SGA "\x03" +set ECHO "\x01" +set SEND "\x01" + +send "$IAC$WILL$ECHO" +send "$IAC$WILL$SGA" +send "$IAC$DO$TTYPE" + +remove_nulls 0 + +expect_before { + -re "^$IAC$DO$ECHO" { + # treat as acknowledgement and ignore + exp_continue + } + -re "^$IAC$DO$SGA" { + # treat as acknowledgement and ignore + exp_continue + } + -re "^$IAC$DO\(.)" { + # refuse anything else + send_user "$IAC$WONT$expect_out(1,string)" + exp_continue + } + -re "^$IAC$WILL$TTYPE" { + # respond to acknowledgement + send_user "$IAC$SB$TTYPE$SEND$IAC$SE" + exp_continue + } + -re "^$IAC$WILL$SGA" { + send_user "$IAC$DO$SGA" + exp_continue + } + -re "^$IAC$WILL\(.)" { + # refuse anything else + send_user "$IAC$DONT$expect_out(1,string)" + exp_continue + } + -re "^$IAC$SB$TTYPE" { + expect_user null + expect_user -re "(.*)$IAC$SE" + set env(TERM) [string tolower $expect_out(1,string)] + # no continue! + } + -re "^$IAC$WONT$TTYPE" { + # treat as acknowledgement and ignore + set env(TERM) vt100 + # no continue! + } +} + +# do negotations up to terminal type +# expect + +############################## +# your code goes after this point here + +# spawn something ;# typically spawn something +# expect ... ;# typically do some expects, sends, etc. +# send ... +# expect ... +# send ... + +# expect_before ;# remove all protocol nonsense + +# let user interact +# interact -re "\r" {send "\r"; expect_user \n {} null} diff --git a/example/ftp-inband b/example/ftp-inband new file mode 100755 index 0000000..5a28302 --- /dev/null +++ b/example/ftp-inband @@ -0,0 +1,302 @@ +#!/bin/sh +# -*- tcl -*- +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh "$0" ${1+"$@"} + +package require Expect + + +# ftp-inband - copy files over a telnet/rlogin/etc link +# Author: Don Libes, NIST +# Date: Jan 11, 1993 + +# Program follows usual conventions and is otherwise self-documenting. +# Assumes standard UNIX conventions on both sides. It uses "compress" +# which can be replaced with gzip or removed totally - it's just there +# for efficiency. +# Assumes error-free transmission (i.e., MNP modems), telnet links, etc. +# Assumes remote shell does not reset tty modes after each command. + +# Note, there is very little error checking. This script was written +# primarily as an exercise - just to demonstrate Expect. + +set prompt "(%|#|\\\$) $" ;# default prompt +catch {set prompt $env(EXPECT_PROMPT)} + +set timeout -1 +set verbose_flag 0 + +proc send_verbose {msg} { + global verbose_flag + + if {$verbose_flag} { + send_user $msg + } +} + +proc get {infile outfile} { + global prompt verbose_flag + + if {!$verbose_flag} { + log_user 0 + } + + send_verbose "disabling echo: " + send "stty -echo\r" + expect -re $prompt + + send_verbose "remote pid is " + send "echo $$\r" + expect -re "(.*)\r\n.*$prompt" {set rpid $expect_out(1,string)} + + set pid [pid] + # pid is local pid, rpid is remote pid + + set infile_plain "/tmp/$rpid" + set infile_compressed "$infile_plain.Z" + set infile_encoded "$infile_compressed.uu" + + set outfile_plain "/tmp/$pid" + set outfile_compressed "$outfile_plain.Z" + set outfile_encoded "$outfile_compressed.uu" + + set out [open $outfile_encoded w] + + send_verbose "compressing\n" + send "compress -fc $infile > $infile_compressed\r" + expect -re $prompt + + # use label corresponding to temporary name on local system + send_verbose "uuencoding\n" + send "uuencode $infile_compressed $outfile_compressed > $infile_encoded\r" + expect -re $prompt + + send_verbose "copying\n" + send "cat $infile_encoded\r" + + log_user 0 + + expect { + -re "^end\r\n" { + puts $out "end" + close $out + } -re "^(\[^\r]*)\r\n" { + puts $out $expect_out(1,string) + send_verbose "." + exp_continue + } + } + + if {$verbose_flag} { + send_user "\n" ;# after last "." + log_user 1 + } + + expect -re $prompt ;# wait for prompt from cat + + send_verbose "deleting temporary files\n" + send "rm -f $infile_compressed $infile_encoded\r" + expect -re $prompt + + send_verbose "switching attention to local system\nuudecoding\n" + exec uudecode $outfile_encoded + + send_verbose "uncompressing\n" + exec uncompress -f $outfile_compressed + + send_verbose "renaming\n" + 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 + } + + # restore echo and serendipitously reprompt + send "stty echo\r" + + log_user 1 +} + +proc put {infile outfile} { + global prompt verbose_flag + + if {!$verbose_flag} { + log_user 0 + } + + send_verbose "disabling echo: " + send "stty -echo\r" + expect -re $prompt + + send_verbose "remote pid is " + send "echo $$\r" + expect -re "(.*)\r\n.*$prompt" {set rpid $expect_out(1,string)} + + set pid [pid] + # pid is local pid, rpid is remote pid + + set infile_plain "/tmp/$pid" + set infile_compressed "$infile_plain.Z" + set infile_encoded "$infile_compressed.uu" + + set outfile_plain "/tmp/$rpid" + set outfile_compressed "$outfile_plain.Z" + set outfile_encoded "$outfile_compressed.uu" + + set out [open $outfile_encoded w] + + send_verbose "compressing\n" + exec compress -fc $infile > $infile_compressed + + # use label corresponding to temporary name on local system + send_verbose "uuencoding\n" + exec uuencode $infile_compressed $outfile_compressed > $infile_encoded + + send_verbose "copying\n" + send "cat > $outfile_encoded\r" + + log_user 0 + + set fp [open $infile_encoded r] + while {1} { + if {-1 == [gets $fp buf]} break + send_verbose "." + send -- "$buf\r" + } + + if {$verbose_flag} { + send_user "\n" ;# after last "." + log_user 1 + } + + send "\004" ;# eof + close $fp + + send_verbose "deleting temporary files\n" + exec rm -f $infile_compressed $infile_encoded + + send_verbose "switching attention to remote system\n" + + expect -re $prompt ;# wait for prompt from cat + + send_verbose "uudecoding\n" + send "uudecode $outfile_encoded\r" + expect -re $prompt + + send_verbose "uncompressing\n" + send "uncompress -f $outfile_compressed\r" + expect -re $prompt + + send_verbose "renaming\n" + send "cp $outfile_plain $outfile\r" + expect -re $prompt + + send_verbose "deleting temporary files\n" + send "rm -f $outfile_plain $outfile_encoded\r" + expect -re $prompt + + # restore echo and serendipitously reprompt + send "stty echo\r" + + log_user 1 +} + +proc get_main {} { + stty -raw echo + send_user "g\nget remote file \[localfile]: " + expect_user { + -re "(\[^ ]+) +(\[^ ]+)\n" { + send_user "copying (remote) $expect_out(1,string) to (local) $expect_out(2,string)\n" + get $expect_out(1,string) $expect_out(2,string) + } -re "(\[^ ]+)\n" { + send_user "copying $expect_out(1,string)\n" + get $expect_out(1,string) $expect_out(1,string) + } -re "\n" { + send_user "eh?\n" + } + } + stty raw -echo +} + +proc put_main {} { + stty -raw echo + send_user "p\nput localfile \[remotefile]: " + expect_user { + -re "(\[^ ]+) +(\[^ ]+)\n" { + send_user "copying (local) $expect_out(1,string) to (remote) $expect_out(2,string)\n" + put $expect_out(1,string) $expect_out(2,string) + } -re "(\[^ ]+)\n" { + send_user "copying $expect_out(1,string)\n" + put $expect_out(1,string) $expect_out(1,string) + } -re "\n" { + send_user "eh?\n" + } + } + stty raw -echo +} + +proc chdir {} { + stty -raw echo + send_user "c\n" + send_user "current directory is [pwd], new directory: " + expect_user -re "(.*)\n" { + cd $expect_out(1,string) + } + stty raw -echo +} + +proc verbose {} { + global verbose_flag + + set verbose_flag [expr !$verbose_flag] + send_user "verbose [verbose_status]\r\n" +} + +proc verbose_status {} { + global verbose_flag + + if {$verbose_flag} { + return "on" + } else { + return "off" + } +} + +proc cmd {} { + set CTRLZ \032 + + send_user "command (g,p,? for more): " + expect_user { + g get_main + p put_main + c chdir + v verbose + ~ {send "~"} + "\\?" { + send_user "?\n" + send_user "~~g get file from remote system\n" + send_user "~~p put file to remote system\n" + send_user "~~c change/show directory on local system\n" + send_user "~~~ send ~~ to remote system\n" + send_user "~~? this list\n" + send_user "~~v verbose mode toggle (currently [verbose_status])\n" + send_user "~~^Z suspend\n" + } + $CTRLZ { + stty -raw echo + exec kill -STOP [pid] + stty raw -echo + } + -re . {send_user "unknown command\n"} + } + send_user "resuming session...\n" +} + +spawn -noecho $env(SHELL) + +send_user "Once logged in, cd to directory to transfer to/from and press: ~~\n" +send_user "One moment...\n" +interact ~~ cmd + diff --git a/example/ftp-rfc b/example/ftp-rfc new file mode 100755 index 0000000..4153b24 --- /dev/null +++ b/example/ftp-rfc @@ -0,0 +1,40 @@ +#!/bin/sh +# -*- tcl -*- +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh "$0" ${1+"$@"} + +package require Expect + + +# ftp-rfc <rfc-number> +# ftp-rfc -index + +# retrieves an rfc (or the index) from uunet + +exp_version -exit 5.0 + +if {$argc!=1} { + send_user "usage: ftp-rfc \[#] \[-index]\n" + exit +} + +set file "rfc$argv.Z" + +set timeout 60 +spawn ftp ftp.uu.net +expect "Name*:" +send "anonymous\r" +expect "Password:" +send "expect@nist.gov\r" +expect "ftp>" +send "binary\r" +expect "ftp>" +send "cd inet/rfc\r" +expect "550*ftp>" exit "250*ftp>" +send "get $file\r" +expect "550*ftp>" exit "200*226*ftp>" +close +wait +send_user "\nuncompressing file - wait...\n" +exec uncompress $file + diff --git a/example/gethostbyaddr b/example/gethostbyaddr new file mode 100755 index 0000000..513a330 --- /dev/null +++ b/example/gethostbyaddr @@ -0,0 +1,333 @@ +#!/bin/sh +# -*- tcl -*- +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh "$0" ${1+"$@"} + +package require Expect + + +# +# gethostbyaddr a.b.c.d - translate an internet address to a FQDN, +# guessing (a lot) if necessary. +# Author: Don Libes, NIST +# Version 4.0 +# Written: January 11, 1991 +# Last revised: March 21, 1996 + +# By default, return a FQDN (fully qualified domain name) or descriptive +# string (if FQDN is not easily determinable). This is tagged with a brief +# explanation of how it was determined. +# +# If the host part of the FQDN cannot be determined, the original IP address +# is used. +# +# Optional arguments act as toggles: Default +# -t tag names with a description of how derived. true +# -v verbose. false +# -r reverse names to see if they resolve back to orig IP address. true +# -n query nic for a descriptive string if it begins to look like true +# the FQDN may be hard to derive. +# -d turn on debugging to expose underlying dialogue false +# +# These options and others (see below) may be set in a ~/.gethostbyaddr file +# To set options from that file, use the same syntax as below. +set timeout 120 ;# timeout query after this many seconds +set tag 1 ;# same as -t +set reverse 1 ;# same as -r +set verbose 0 ;# same as -v +set nic 1 ;# same as -n +set debug 0 ;# same as -d +log_user 0 + +proc usage {} { + send_user "usage: gethostbyaddr \[options\] a.b.c.d\n" + send_user "options meaning (all options act as toggles) default\n" + send_user " -t tag with derivation description true\n" + send_user " -v verbose false\n" + send_user " -r reverse back to IP addr for verification true\n" + send_user " -n query nic true\n" + send_user " -d produce debugging output false\n" + send_user "options must be separate.\n" + exit +} + +if {[file readable ~/.gethostbyaddr]} {source ~/.gethostbyaddr} + +while {[llength $argv]>0} { + set flag [lindex $argv 0] + switch -- $flag \ + "-v" { + set verbose [expr !$verbose] + set argv [lrange $argv 1 end] + } "-r" { + set reverse [expr !$reverse] + set argv [lrange $argv 1 end] + } "-n" { + set nic [expr !$nic] + set argv [lrange $argv 1 end] + } "-t" { + set tag [expr !$tag] + set argv [lrange $argv 1 end] + } "-d" { + set debug [expr !$debug] + set argv [lrange $argv 1 end] + debug $debug + } default { + break + } +} + +set IPaddress $argv + +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 + send_user $s\n +} + +# dn==1 if domain name, 0 if text (from nic) +proc printhost {name how dn} { + global reverse tag IPaddress + + if {$dn && $reverse} { + set verified [verify $name $IPaddress] + } else {set verified 0} + + if {$verified || !$reverse || !$dn} { + if {$tag} { + send_user "$name ($how)\n" + } else { + send_user "$name\n" + } + + if {$verified || !$reverse} { + close + wait + exit + } + } +} + +# return 1 if name resolves to IP address +proc verify {name IPaddress} { + vprint "verifying $name is $IPaddress" + set rc 0 + spawn nslookup + expect ">*" + send $name\r + + expect { + -re "\\*\\*\\* (\[^\r]*)\r" { + 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]} { + vprint "verified" + set rc 1 + } else { + vprint "not verified - $name is $addr2" + } + } + } + close + wait + return $rc +} + +set bad_telnet_responses "(telnet:|: unknown).*" + +proc telnet_error {s} { + regexp ": (.*)\r" $s dontcare msg + vprint $msg +} + +proc guessHost {guess} { + global guessHost + if {[info exists guessHost]} return + set guessHost $guess +} + +proc guessDomain {guess} { + global guessDomain + if {[info exists guessDomain]} return + set guessDomain $guess +} + +proc guessFQDN {} { + global guessHost guessDomain + return $guessHost.$guessDomain +} + +###################################################################### +# first do a simple reverse nslookup +###################################################################### + +vprint "using nslookup" +spawn nslookup +expect ">*" +send "set query=ptr\r" +expect ">*" +send "$d.$c.$b.$a.in-addr.arpa\r" +expect { + timeout { + vprint "timed out" + } -re "\\*\\*\\* (\[^\r]*)\r" { + vprint $expect_out(1,string) + } -re "name = (\[^\r]*)\r" { + set host $expect_out(1,string) + printhost $host nslookup 1 + + # split out hostname from FQDN as guess for later + guessHost [lindex [split $host "."] 0] + } +} + +close +wait + +###################################################################### +# next telnet to host and ask it what its name is +###################################################################### + +vprint "talking smtp to $IPaddress" +spawn telnet $IPaddress smtp +expect { + -re $bad_telnet_responses { + telnet_error $expect_out(buffer) + } timeout { + vprint "timed out" + } -re "\n220 (\[^\\. ]*).?(\[^ ]*)" { + 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]} { + guessDomain $host.$domain + } else { + guessHost $host + } + } +} +catch close +wait + +###################################################################### +# ask NIC for any info about this host +###################################################################### + +if {$nic || ($d == 0)} { + vprint "talking to nic" + spawn telnet internic.net + expect { + -re $bad_telnet_responses { + telnet_error $expect_out(buffer) + } timeout { + vprint "timed out" + } "InterNIC >" { + send "whois\r" + expect "Whois: " + vprint "getting info on network $a.$b.$c" + send "net $a.$b.$c\r" + expect { + "No match*" { + vprint "no info" + expect "Whois: " + vprint "getting info on network $a.$b" + send "net $a.$b\r" + expect { + "No match*" { + vprint "no info" + } -re "net\r\n(\[^\r]*)\r" { + printhost $expect_out(1,string) nic 0 + } timeout { + vprint "timed out" + } + } + } -re "net\r\n(\[^\r]*)\r" { + printhost $expect_out(1,string) nic 0 + } timeout { + vprint "timed out" + } + } + } + } + catch close + wait + if {$d == 0} exit +} + +###################################################################### +# ask other hosts in the same class C what their name is +# so that we can at least get the likely domain +# +# do this in two loops - first from current IP address down to 0 +# and then next from current IP address up to 255 +###################################################################### + +# give up guessing host name +guessHost "unknown" + +for {set i [expr $d-1]} {$i>0} {incr i -1} { + vprint "talking smtp to $a.$b.$c.$i" + spawn telnet $a.$b.$c.$i smtp + expect { + -re $bad_telnet_responses { + telnet_error $expect_out(buffer) + } timeout { + vprint "timed out" + } -re "\n220 (\[^\\. ]*).?(\[^ ]*)" { + set host $expect_out(1,string) + set domain $expect_out(2,string) + 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]} { + guessDomain $host.$domain + } + } + } + catch close + wait +} + +for {set i [expr $d+1]} {$i<255} {incr i} { + vprint "talking smtp to $a.$b.$c.$i" + spawn telnet $a.$b.$c.$i smtp + expect { + -re $bad_telnet_responses { + telnet_error $expect_out(buffer) + } timeout { + vprint "timed out" + } -re "\n220 (\[^ ]*.(\[^ ])) " { + set host $expect_out(1,string) + set domain $expect_out(2,string) + 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]} { + guessDomain $host.$domain + } + } + } + catch close + wait +} + +###################################################################### +# print our best guess as to the name +###################################################################### + + +# How pathetic. Print something, anything! +if {!$verbose && !$tag} {send_user [guessFQDN]} diff --git a/example/getpassck b/example/getpassck new file mode 100644 index 0000000..9730e39 --- /dev/null +++ b/example/getpassck @@ -0,0 +1,37 @@ +#!/bin/sh +# \ +exec expect "$0" ${1+"$@"} +# +# Name: getpassck +# +# Description: +# This script demonstrates when programs using getpass sometimes +# fail. The reason is that some implementations of getpass prompt +# before the pty/tty has completed the switch to no-echo. This may +# not be obvious from examination of the implementation of getpass +# itself because the driver itself may cut corners and be +# responsible for allowing the call to return prematurely. +# +# Directions: +# Simply run this script. It will loop 100 times attempting to +# generate the getpass problem. If the bug cannot be reproduced, +# you will see 100 failed attempts to su. If the bug can be +# reproduced, the script exits as soon as it is detected. +# +# Author: Don Libes <don@libes.com> +# Version: 1.0, Wed Mar 9 12:36:12 EST 2005 +# + +for {set i 0} {$i < 100} {incr i} { + spawn -noecho su + expect ": " ;# get password prompt as quickly as possible + send "X\r" ;# send password + expect X { + puts "Password was echoed! This system has the getpass problem." + exit + } "orry" { + close + wait + } +} +puts "Failed to reproduce getpass problem." diff --git a/example/irsh b/example/irsh new file mode 100755 index 0000000..029c8c8 --- /dev/null +++ b/example/irsh @@ -0,0 +1,11 @@ +#!/depot/path/expect -- + +# Do rsh interactively. For example, consider the following command: +# rsh <remote> ls -l "|" more +# where it would be nice to get a listing page by page + +spawn -noecho rlogin [lindex $argv 0] +set timeout -1 +expect "% " ;# customize appropriately +send "[lrange $argv 1 end];exit\r" +interact diff --git a/example/kibitz b/example/kibitz new file mode 100755 index 0000000..eacb139 --- /dev/null +++ b/example/kibitz @@ -0,0 +1,415 @@ +#!/bin/sh +# -*- tcl -*- +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh "$0" ${1+"$@"} + +package require Expect + + +# allow another user to share a shell (or other program) with you +# See kibitz(1) man page for complete info. +# Author: Don Libes, NIST +# Date written: December 5, 1991 +# Date last editted: October 19, 1994 +# Version: 2.11 +exp_version -exit 5.0 + +# if environment variable "EXPECT_PROMPT" exists, it is taken as a regular +# expression which matches the end of your login prompt (but does not other- +# wise occur while logging in). + +set prompt "(%|#|\\$) $" ;# default prompt +set noproc 0 +set tty "" ;# default if no -tty flag +set allow_escape 1 ;# allow escapes if true +set escape_char \035 ;# control-right-bracket +set escape_printable "^\]" +set verbose 1 ;# if true, describe what kibitz is doing + +set kibitz "kibitz" ;# where kibitz lives if some unusual place. + ;# this must end in "kibitz", but can have + ;# things in front (like directory names). +#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" +} else { + 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" + +# Some flags must be passed onto the remote kibitz process. They are stored +# in "kibitz_flags". Currently, they include -tty and -silent. +set kibitz_flags "" + +while {[llength $argv]>0} { + set flag [lindex $argv 0] + switch -- $flag \ + "-noproc" { + set noproc 1 + set argv [lrange $argv 1 end] + } "-catu" { + set catflags "-u" + set argv [lrange $argv 1 end] + } "-tty" { + set tty [lindex $argv 1] + set argv [lrange $argv 2 end] + set kibitz_flags "$kibitz_flags -tty $tty" + } "-noescape" { + set allow_escape 0 + set argv [lrange $argv 1 end] + } "-escape" { + set escape_char [lindex $argv 1] + set escape_printable $escape_char + set argv [lrange $argv 2 end] + } "-silent" { + set verbose 0 + set argv [lrange $argv 1 end] + set kibitz_flags "$kibitz_flags -silent" + } "-proxy" { + set proxy [lindex $argv 1] + set argv [lrange $argv 2 end] + } default { + break + } +} + +if {([llength $argv]<1) && ($noproc==0)} { + send_user "usage: kibitz \[args] user \[program ...]\n" + send_user " or: kibitz \[args] user@host \[program ...]\n" + exit +} + +log_user 0 +set timeout -1 + +set user [lindex $argv 0] +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] +} else { + set user_number [expr 1+(0==[string first - $user])] +} + +# at this point, user_number and user are correctly determined +# User who originated kibitz session has user_number == 1 on local machine. +# User who is responding to kibitz has user_number == 2. +# User who originated kibitz session has user_number == 3 on remote machine. + +# user 1 invokes kibitz as "kibitz user[@host]" +# user 2 invokes kibitz as "kibitz -####" (some pid). +# user 3 invokes kibitz as "kibitz -r user". + +# uncomment for debugging: leaves each user's session in a file: 1, 2 or 3 +#exec rm -f $user_number +#exp_internal -f $user_number 0 + +set user2_islocal 1 ;# assume local at first + +# later move inside following if $user_number == 1 +# return true if x is a prefix of xjunk, given that prefixes are only +# valid at . delimiters +# 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} + } + 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" +} + +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 -] +} + +set local_io [expr ($user_number==3)||$user2_islocal] +if {$local_io||($user_number==2)} { + if {0==[info exists pid]} {set pid [pid]} + + set userinfile /tmp/exp0.$pid + set useroutfile /tmp/exp1.$pid +} + +proc prompt1 {} { + return "kibitz[info level].[history nextid]> " +} + +set esc_match {} +if {$allow_escape} { + set esc_match { + $escape_char { + send_user "\nto exit kibitz, enter: exit\n" + send_user "to suspend kibitz, press appropriate job control sequence\n" + send_user "to return to kibitzing, enter: return\n" + interpreter + send_user "returning to kibitz\n" + } + } +} + +proc prompt1 {} { + 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 +} + +# only user_numbers 1 and 3 execute remaining code + +proc abort {} { + # 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} { + 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 + if 0==[catch {exec /etc/mknod $f p}] return ;# AIX, Cray + puts "Couldn't figure out how to make a fifo - where is mknod?" + abort + } + + proc rmfifos {} { + global userinfile useroutfile + catch {exec rm -f $userinfile $useroutfile} + } + + trap {rmfifos; exit} {SIGINT SIGQUIT SIGTERM} + + # create 2 fifos to communicate with other user + 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"} + + # can't use exec since write insists on being run from a tty! + set rc [catch { + system echo "Can we talk? Run: \"kibitz -$pid\"" | \ + write $user $tty + } + ] + if {$rc} {rmfifos;abort} + + spawn -open [open $useroutfile w] + set userout $spawn_id + # open will hang until other user's cat starts + + spawn -open [open "|cat $catflags < $userinfile" "r"] + set userin $spawn_id + 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 eof { + close -i $userout + wait -i $userout + return + } -output "$user_spawn_id $userout" + } + wait -i $shell + } +} + +if {$local_io} rmfifos diff --git a/example/kibitz.man b/example/kibitz.man new file mode 100644 index 0000000..ef1d320 --- /dev/null +++ b/example/kibitz.man @@ -0,0 +1,266 @@ +.TH KIBITZ 1 "19 October 1994" +.SH NAME +kibitz \- allow two people to interact with one shell +.SH SYNOPSIS +.B kibitz +[ +.I kibitz-args +] +.I user +[ +.I program program-args... +] +.br +.B kibitz +[ +.I kibitz-args +] +.I user@host +[ +.I program program-args... +] +.SH INTRODUCTION +.B kibitz +allows two (or more) people to interact with one shell (or any arbitrary +program). Uses include: +.RS +.TP 4 +\(bu +A novice user can ask an expert user for help. Using +.BR kibitz , +the expert can see what the user is doing, and offer advice or +show how to do it right. +.TP +\(bu +By running +.B kibitz +and then starting a full-screen editor, people may carry out a +conversation, retaining the ability to scroll backwards, +save the entire conversation, or even edit it while in progress. +.TP +\(bu +People can team up on games, document editing, or other cooperative +tasks where each person has strengths and weaknesses that complement one +another. +.SH USAGE +To start +.BR kibitz , +user1 +runs kibitz with the argument of the +user to kibitz. For example: + + kibitz user2 + +.B kibitz +starts a new shell (or another program, if given on the command +line), while prompting user2 to run +.BR kibitz . +If user2 runs +.B kibitz +as directed, the keystrokes of both users become the input of +the shell. Similarly, both users receive the output from the +shell. + +To terminate +.B kibitz +it suffices to terminate the shell itself. For example, if either user +types ^D (and the shell accepts this to be EOF), the shell terminates +followed by +.BR kibitz . + +Normally, all characters are passed uninterpreted. However, if the +escape character (described when +.B kibitz +starts) is issued, the user +may talk directly to the +.B kibitz +interpreter. Any +.BR Expect (1) +or +.BR Tcl (3) +commands may be given. +Also, job control may be used while in the interpreter, to, for example, +suspend or restart +.BR kibitz . + +Various processes +can provide various effects. For example, you can emulate a two-way write(1) +session with the command: + + kibitz user2 sleep 1000000 +.SH ARGUMENTS +.B kibitz +takes arguments, these should also be separated by whitespace. + +The +.B \-noproc +flag runs +.B kibitz +with no process underneath. Characters are passed to the other +.BR kibitz . +This is particularly useful for connecting multiple +interactive processes together. +In this mode, characters are not echoed back to the typist. + +.B \-noescape +disables the escape character. + +.BI \-escape " char" +sets the escape character. The default escape character is ^]. + +.B \-silent +turns off informational messages describing what kibitz is doing to +initiate a connection. + +.BI \-tty " ttyname" +defines the tty to which the invitation should be sent. + +If you start +.B kibitz +to user2 on a remote computer, +.B kibitz +performs a +.B rlogin +to the remote computer with your current username. The flag +.BI \-proxy " username" +causes +.B rlogin +to use +.I username +for the remote login (e.g. if your account on the remote computer has a +different username). If the +.B -proxy +flag is not given, +.B kibitz +tries to determine your current username by (in that order) inspecting the +environment variables USER and LOGNAME, then by using the commands +.B whoami +and +.BR logname . + +The arguments +.B -noescape +and +.B -escape +can also be given by user2 when prompted to run +.BR kibitz . + +.SH MORE THAN TWO USERS +The current implementation of kibitz explicitly understands only two users, +however, it is nonetheless possible to have a three (or more) -way kibitz, +by kibitzing another +.BR kibitz . +For example, the following command runs +.B kibitz +with the current user, user2, and user3: + + % kibitz user2 kibitz user3 + +Additional users may be added by simply appending more "kibitz user" +commands. + +The +.B xkibitz +script is similar to +.B kibitz +but supports the ability to add additional users (and drop them) +dynamically. +.SH CAVEATS +.B kibitz +assumes the 2nd user has the same terminal type and size as the 1st user. +If this assumption is incorrect, graphical programs may display oddly. + +.B kibitz +handles character graphics, but cannot handle bitmapped graphics. Thus, +.nf + + % xterm -e kibitz will work + % kibitz xterm will not work + +.fi +However, you can get the effect of the latter command by using +.B xkibitz +(see SEE ALSO below). +.B kibitz +uses the same permissions as used by rlogin, rsh, etc. Thus, you +can only +.B kibitz +to users at hosts for which you can rlogin. +Similarly, +.B kibitz +will prompt for a password on the remote host if +rlogin would. + +If you +.B kibitz +to users at remote hosts, +.B kibitz +needs to distinguish your prompt from other things that may precede it +during login. +(Ideally, the end of it is preferred but any part should suffice.) +If you have an unusual prompt, +set the environment variable EXPECT_PROMPT to an egrep(1)-style +regular expression. +Brackets should be preceded with one backslash in ranges, +and three backslashes for literal brackets. +The default prompt r.e. is "($|%|#)\ ". + +.B kibitz +requires the +.B kibitz +program on both hosts. +.B kibitz +requires +.BR expect (1). + +By comparison, the +.B xkibitz +script uses the X authorization mechanism for inter-host communication +so it does not need to login, recognize your prompt, or require kibitz +on the remote host. It does however need permission to access +the other X servers. +.SH BUGS +An early version of Sun's tmpfs had a bug in it that causes +.B kibitz +to blow up. If +.B kibitz +reports "error flushing ...: Is a directory" +ask Sun for patch #100174. + +If your Expect is not compiled with multiple-process support (i.e., you do not +have a working select or poll), you will not be able to run kibitz. +.SH ENVIRONMENT +The environment variable SHELL is used to determine the shell to start, if no +other program is given on the command line. + +If the environment variable EXPECT_PROMPT exists, it is taken as a regular +expression which matches the end of your login prompt (but does not otherwise +occur while logging in). See also CAVEATS above. + +If the environment variables USER or LOGNAME are defined, they are used to +determine the current user name for a +.B kibitz +to a remote computer. See description of the +.B -proxy +option in ARGUMENTS above. +.SH SEE ALSO +.BR Tcl (3), +.BR libexpect (3), +.BR xkibitz (1) +.br +.I +"Exploring Expect: A Tcl-Based Toolkit for Automating Interactive Programs" +\fRby Don Libes, +O'Reilly and Associates, January 1995. +.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. +.SH AUTHOR +Don Libes, National Institute of Standards and Technology + +.B kibitz +is in the public domain. +NIST and I would +appreciate credit if this program or parts of it are used. diff --git a/example/lpunlock b/example/lpunlock new file mode 100755 index 0000000..2b7ea24 --- /dev/null +++ b/example/lpunlock @@ -0,0 +1,101 @@ +#!/bin/sh +# -*- tcl -*- +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh "$0" ${1+"$@"} + +package require Expect + + +# This script unhangs a printer which claims it is "waiting for lock". +# Written by Don Libes. Based on English instructions from Scott Paisley. + +# lpunlock figures out if the printer is on a server, and if so which, +# by looking in the local printcap file. (You can override this by +# supplying a server name as an additional argument.) It then rlogins +# to the server, recreates the device and resets the queue via lpc. + +# assumes user has root privs on remote host via /.rhosts + +# assumes printer is name of device on remote system + +proc usage {} { + send_user "usage: lpunlock <printer> \[<server>\]\n" + send_user "example: lpunlock lw-isg durer\n" + exit +} + +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} {} { + expect -re ".*:rm=(\[^:]*):.*\r\n" { + set server $expect_out(1,string) + break + } "\r\n*\\\r\n" { ;# look at next line of entry + send "\r" + } "\r\n*\n" { ;# no more lines of entry - give up + set server $client + break + } + } +} else { + if {$argc == 2} { + set server [lindex $argv 1] + } else usage +} + +set whoami [exec whoami] +if {[string match $server $client] && [string match $whoami "root"]} { + spawn csh + expect "# " +} else { + # login to the print server as root. + # Set timeout high because login is slow. + set timeout 60 + spawn rlogin $server -l root + expect timeout exit \ + eof exit \ + "Password*" { + send_user "\ncouldn't login to $server as root\n" + exit + } "1#*" + set timeout 10 +} + +# run lpc and 'stop printer' +send lpc\r ; expect "lpc>*" +send stop $printer\r ; expect "unknown*" exit \ + "disabled*lpc>*" + +# exit lpc and cd /dev +send quit\r ; expect "#*" +send cd /dev\r ; expect "#*" + +# figure out major/minor device numbers +send ls -l /dev/$printer\r ; expect timeout { + send_user "\nbad device - couldn't get major/minor numbers\n"; exit + } "crw*#*" +scan $expect_out(buffer) "ls -l %*s %*s 1 root %d, %d" major minor + +# delete the lock and the printer device itself +send rm /var/spool/$printer/lock /dev/$printer\r ; expect #* + +# recreate the printer device +send mknod $printer c $major $minor\r ; expect #* + +# run lpc and 'start printer' +send lpc\r ; expect lpc>* +send start $printer\r ; expect started*lpc>* +send quit\r ; expect #* + +# logout +send exit\r ; expect eof + +send_user Printer unlocked and restarted.\n diff --git a/example/mkpasswd b/example/mkpasswd new file mode 100755 index 0000000..6016b56 --- /dev/null +++ b/example/mkpasswd @@ -0,0 +1,216 @@ +#!/bin/sh +# -*- tcl -*- +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh "$0" ${1+"$@"} + +package require Expect + + +# mkpasswd - make a password, if username given, set it. +# Author: Don Libes, NIST + +# 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/nispasswd]} { + set defaultprog /bin/nispasswd +} elseif {[file executable /bin/yppasswd]} { + set defaultprog /bin/yppasswd +} elseif {[file executable /bin/passwd]} { + set defaultprog /bin/passwd +} else { + set defaultprog passwd +} +set prog $defaultprog + +while {[llength $argv]>0} { + set flag [lindex $argv 0] + switch -- $flag \ + "-l" { + set length [lindex $argv 1] + set argv [lrange $argv 2 end] + } "-d" { + set minnum [lindex $argv 1] + set argv [lrange $argv 2 end] + } "-c" { + 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] + set argv [lrange $argv 2 end] + } "-2" { + set distribute 1 + set argv [lrange $argv 1 end] + } default { + set user [lindex $argv 0] + set argv [lrange $argv 1 end] + break + } +} + +if {[llength $argv]} { + puts "usage: mkpasswd \[args] \[user]" + 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 + $minspecial > $length} { + puts "impossible to generate $length-character password\ + with $minnum numbers, $minlower lowercase 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 + $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, thereby spreading +# the different kinds of characters throughout the password +proc insert {pvar char} { + upvar $pvar p + + set p [linsert $p [rand [expr {(1+[llength $p])}]] $char] +} + +proc rand {m} { + expr {int($m*rand())} +} + +# choose left or right starting hand +set initially_left [set isleft [rand 2]] + +# 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] + } +} + +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]] +} +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]]] +} + +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 +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 + } + + spawn $prog $user + expect { + "assword*:" { + # some systems say "Password (again):" + send "$password\r" + exp_continue + } + } + + # if user isn't watching, check status + if {!$verbose} { + if {[lindex [wait] 3]} { + puts -nonewline "$expect_out(buffer)" + exit 1 + } + } + + if {$verbose} { + puts -nonewline "password for $user is " + } +} + +puts "$password" diff --git a/example/mkpasswd.man b/example/mkpasswd.man new file mode 100644 index 0000000..9da760c --- /dev/null +++ b/example/mkpasswd.man @@ -0,0 +1,100 @@ +.TH MKPASSWD 1 "22 August 1994" +.SH NAME +mkpasswd \- generate new password, optionally apply it to a user +.SH SYNOPSIS +.B mkpasswd +.I +[ +.I args +] +[ +.I user +] +.SH INTRODUCTION +.B mkpasswd +generates passwords and can apply them automatically to users. +mkpasswd is based on the code from Chapter 23 of the O'Reilly book +"Exploring Expect". +.SH USAGE +With no arguments, +.B mkpasswd +returns a new password. + + mkpasswd + +With a user name, +.B mkpasswd +assigns a new password to the user. + + mkpasswd don + +The passwords are randomly generated according to the flags below. + +.SH FLAGS +The +.B \-l +flag defines the length of the password. The default is 9. +The following example creates a 20 character password. + + mkpasswd -l 20 + +The +.B \-d +flag defines the minimum number of digits that must be in the password. +The default is 2. The following example creates a password with at least +3 digits. + + mkpasswd -d 3 + +The +.B \-c +flag defines the minimum number of lowercase alphabetic characters that must be in the password. +The default is 2. + +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. + +The +.B \-2 +flag causes characters to be chosen so that they alternate between +right and left hands (qwerty-style), making it harder for anyone +watching passwords being entered. This can also make it easier for +a password-guessing program. + +The +.B \-v +flag causes the password-setting interaction to be visible. +By default, it is suppressed. + +.SH EXAMPLE +The following example creates a 15-character password +that contains at least 3 digits and 5 uppercase characters. + + mkpasswd -l 15 -d 3 -C 5 + +.SH SEE ALSO +.I +"Exploring Expect: A Tcl-Based Toolkit for Automating Interactive Programs" +\fRby Don Libes, +O'Reilly and Associates, January 1995. +.SH AUTHOR +Don Libes, National Institute of Standards and Technology + +.B mkpasswd +is in the public domain. +NIST and I would +appreciate credit if this program or parts of it are used. + + diff --git a/example/multixterm b/example/multixterm new file mode 100755 index 0000000..d0abfe7 --- /dev/null +++ b/example/multixterm @@ -0,0 +1,993 @@ +#!/bin/sh +# -*- tcl -*- +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh "$0" ${1+"$@"} + +package require Expect + +# +# NAME +# multixterm - drive multiple xterms separately or together +# +# SYNOPSIS +# multixterm [-xa "xterm args"] +# [-xc "command"] +# [-xd "directory"] +# [-xf "file"] +# [-xn "xterm names"] +# [-xv] (enable verbose mode) +# [-xh] or [-x?] (help) +# [xterm names or user-defined args...] +# +# DESCRIPTION +# Multixterm creates multiple xterms that can be driven together +# or separately. +# +# In its simplest form, multixterm is run with no arguments and +# commands are interactively entered in the first entry field. +# Press return (or click the "new xterm" button) to create a new +# xterm running that command. +# +# Keystrokes in the "stdin window" are redirected to all xterms +# started by multixterm. xterms may be driven separately simply +# by focusing on them. +# +# The stdin window must have the focus for keystrokes to be sent +# to the xterms. When it has the focus, the color changes to +# aquamarine. As characters are entered, the color changes to +# green for a second. This provides feedback since characters +# are not echoed in the stdin window. +# +# Typing in the stdin window while holding down the alt or meta +# keys sends an escape character before the typed characters. +# This provides support for programs such as emacs. +# +# ARGUMENTS +# The optional -xa argument indicates arguments to pass to +# xterm. +# +# The optional -xc argument indicates a command to be run in +# each named xterm (see -xn). With no -xc argument, the command +# is the current shell. +# +# The optional -xd argument indicates a directory to search for +# files that will appear in the Files menu. By default, the +# directory is: ~/lib/multixterm +# +# The optional -xf argument indicates a file to be read at +# startup. See FILES below for more info. +# +# The optional -xn argument indicates a name for each xterm. +# This name will also be substituted for any %n in the command +# argument (see -xc). +# +# The optional -xv flag puts multixterm into a verbose mode +# where it will describe some of the things it is doing +# internally. The verbose output is not intended to be +# understandable to anyone but the author. +# +# Less common options may be changed by the startup file (see +# FILES below). +# +# All the usual X and wish flags are supported (i.e., -display, +# -name). There are so many of them that to avoid colliding and +# make them easy to remember, all the multixterm flags begin +# with -x. +# +# If any arguments do not match the flags above, the remainder +# of the command line is made available for user processing. By +# default, the remainder is used as a list of xterm names in the +# style of -xn. The default behavior may be changed using the +# .multixtermrc file (see DOT FILE below). +# +# EXAMPLE COMMAND LINE ARGUMENTS +# The following command line starts up two xterms using ssh to +# the hosts bud and dexter. +# +# multixterm -xc "ssh %n" bud dexter +# +# FILES +# Command files may be used to drive or initialize multixterm. +# The File menu may be used to invoke other files. If files +# exist in the command file directory (see -xd above), they will +# appear in the File menu. Files may also be loaded by using +# File->Open. Any filename is acceptable but the File->Open +# browser defaults to files with a .mxt suffix. +# +# Files are written in Tcl and may change any variables or +# invoke any procedures. The primary variables of interest are +# 'xtermCmd' which identifies the command (see -xc) and +# 'xtermNames' which is a list of names (see -xn). The +# procedure xtermStartAll, starts xterms for each name in the +# list. Other variables and procedures may be discovered by +# examining multixterm itself. +# +# EXAMPLE FILE +# The following file does the same thing as the earlier example +# command line: +# +# # start two xterms connected to bud and dexter +# set xtermCmd "ssh %n" +# set xtermNames {bud dexter} +# xtermStartAll +# +# DOT FILE +# At startup, multixterm reads ~/.multixtermrc if present. This +# is similar to the command files (see FILES above) except that +# .multixtermrc may not call xtermStartAll. Instead it is +# called implicitly, similar to the way that it is implicit in +# the command line use of -xn. +# +# The following example .multixtermrc file makes every xterm run +# ssh to the hosts named on the command line. +# +# set xtermCmd "ssh %n" +# +# Then multixterm could be called simply: +# +# multixterm bud dexter +# +# If any command-line argument does not match a multixterm flag, +# the remainder of the command line is made available to +# .multixtermrc in the argv variable. If argv is non-empty when +# .multixtermrc returns, it is assigned to xtermNames unless +# xtermNames is non-empty in which case, the content of argv is +# ignored. +# +# Commands from .multixtermrc are evaluated early in the +# initialization of multixterm. Anything that must be done late +# in the initialization (such as adding additional bindings to +# the user interface) may be done by putting the commands inside +# a procedure called "initLate". +# +# MENUS +# Except as otherwise noted, the menus are self-explanatory. +# Some of the menus have dashed lines as the first entry. +# Clicking on the dashed lines will "tear off" the menus. +# +# USAGE SUGGESTION - ALIASES AND COMMAND FILES +# Aliases may be used to store lengthy command-line invocations. +# Command files can be also be used to store such invocations +# as well as providing a convenient way to share configurations. +# +# Tcl is a general-purpose language. Thus multixterm command +# files can be extremely flexible, such as loading hostnames +# from other programs or files that may change from day-to-day. +# In addition, command files can be used for other purposes. +# For example, command files may be used to prepared common +# canned interaction sequences. For example, the command to +# send the same string to all xterms is: +# +# xtermSend "a particularly long string" +# +# The File menu (torn-off) makes canned sequences particularly +# convenient. Interactions could also be bound to a mouse +# button, keystroke, or added to a menu via the .multixtermrc +# file. +# +# USAGE SUGGESTION - HANDLING MANY XTERMS BY TILING +# The following .multixtermrc causes tiny xterms to tile across +# and down the screen. (You may have to adjust the parameters +# for your screen.) This can be very helpful when dealing with +# large numbers of xterms. +# +# set yPos 0 +# set xPos 0 +# +# trace variable xtermArgs r traceArgs +# +# proc traceArgs {args} { +# global xPos yPos +# set ::xtermArgs "-geometry 80x12+$xPos+$yPos -font 6x10" +# if {$xPos} { +# set xPos 0 +# incr yPos 145 +# if {$yPos > 800} {set yPos 0} +# } else { +# set xPos 500 +# } +# } +# +# The xtermArgs variable in the code above is the variable +# corresponding to the -xa argument. +# +# xterms can be also be created directly. The following command +# file creates three xterms overlapped horizontally: +# +# set xPos 0 +# +# foreach name {bud dexter hotdog} { +# set ::xtermArgs "-geometry 80x12+$xPos+0 -font 6x10" +# set ::xtermNames $name +# xtermStartAll +# incr xPos 300 +# } +# +# USAGE SUGGESTION - SELECTING HOSTS BY NICKNAME +# The following .multixtermrc shows an example of changing the +# default handling of the arguments from hostnames to a filename +# containing hostnames: +# +# set xtermNames [exec cat $argv] +# +# The following is a variation, retrieving the host names from +# the yp database: +# +# set xtermNames [exec ypcat $argv] +# +# The following hardcodes two sets of hosts, so that you can +# call multixterm with either "cluster1" or "cluster2": +# +# switch $argv { +# cluster1 { +# set xtermNames "bud dexter" +# } +# cluster2 { +# set xtermNames "frank hotdog weiner" +# } +# } +# +# COMPARE/CONTRAST +# It is worth comparing multixterm to xkibitz. Multixterm +# connects a separate process to each xterm. xkibitz connects +# the same process to each xterm. +# +# LIMITATIONS +# Multixterm provides no way to remotely control scrollbars, +# resize, and most other window system related functions. +# +# Multixterm can only control new xterms that multixterm itself +# has started. +# +# As a convenience, the File menu shows a limited number of +# files. To show all the files, use File->Open. +# +# FILES +# $DOTDIR/.multixtermrc initial command file +# ~/.multixtermrc fallback command file +# ~/lib/multixterm/ default command file directory +# +# BUGS +# If multixterm is killed using an uncatchable kill, the xterms +# are not killed. This appears to be a bug in xterm itself. +# +# Send/expect sequences can be done in multixterm command files. +# However, due to the richness of the possibilities, to document +# it properly would take more time than the author has at present. +# +# REQUIREMENTS +# Requires Expect 5.36.0 or later. +# Requires Tk 8.3.3 or later. +# +# VERSION +#! $::versionString +# The latest version of multixterm is available from +# http://expect.nist.gov/example/multixterm . If your version of Expect +# and Tk are too old (see REQUIREMENTS above), download a new version of +# Expect from http://expect.nist.gov +# +# DATE +#! $::versionDate +# +# AUTHOR +# Don Libes <don@libes.com> +# +# LICENSE +# Multixterm is in the public domain; however the author would +# appreciate acknowledgement if multixterm or parts of it or ideas from +# it are used. + +###################################################################### +# user-settable things - override them in the ~/.multixtermrc file +# or via command-line options +###################################################################### + +set palette #d8d8ff ;# lavender +set colorTyping green +set colorFocusIn aquamarine + +set xtermNames {} +set xtermCmd $env(SHELL) +set xtermArgs "" +set cmdDir ~/lib/multixterm +set inputLabel "stdin window" + +set fileMenuMax 30 ;# max number of files shown in File menu +set tearoffMenuMin 2 ;# min number of files needed to enable the File + ;# menu to be torn off + +proc initLate {} {} ;# anything that must be done late in initialization + ;# such as adding/modifying bindings, may be done by + ;# redefining this + +###################################################################### +# end of user-settable things +###################################################################### + +###################################################################### +# sanity checking +###################################################################### + +set versionString 1.8 +set versionDate "2004/06/29" + +package require Tcl +catch {package require Tk} ;# early versions of Tk had no package +package require Expect + +proc exit1 {msg} { + puts "multixterm: $msg" + exit 1 +} + +exp_version -exit 5.36 + +proc tkBad {} { + exit1 "requires Tk 8.3.3 or later but you are using Tk $::tk_patchLevel." +} + +if {$tk_version < 8.3} { + tkBad +} elseif {$tk_version == 8.3} { + if {[lindex [split $tk_patchLevel .] 2] < 3} tkBad +} + +###################################################################### +# process args - has to be done first to get things like -xv working ASAP +###################################################################### + +# set up verbose mechanism early + +set verbose 0 +proc verbose {msg} { + if {$::verbose} { + if {[info level] > 1} { + set proc [lindex [info level -1] 0] + } else { + set proc main + } + puts "$proc: $msg" + } +} + +# read a single argument from the command line +proc arg_read1 {var args} { + if {0 == [llength $args]} { + set argname -$var + } else { + set argname $args + } + + upvar argv argv + upvar $var v + + verbose "$argname" + if {[llength $argv] < 2} { + exit1 "$argname requires an argument" + } + + set v [lindex $argv 1] + verbose "set $var $v" + set argv [lrange $argv 2 end] +} + +proc xtermUsage {{msg {}}} { + if {![string equal $msg ""]} { + puts "multixtermrc: $msg" + } + puts {usage: multixterm [flags] ... where flags are: + [-xa "xterm args"] + [-xc "command"] + [-xd "directory"] + [-xf "file"] + [-xn "xterm names"] + [-xv] (enable verbose mode) + [-xh] or [-x?] (help) + [xterm names or user-defined args...]} + exit +} + +while {[llength $argv]} { + set flag [lindex $argv 0] + switch -- $flag -x? - -xh { + xtermUsage + } -xc { + arg_read1 xtermCmd -xc + } -xn { + arg_read1 xtermNames -xn + } -xa { + arg_read1 xtermArgs -xa + } -xf { + arg_read1 cmdFile -xf + if {![file exists $cmdFile]} { + exit1 "can't read $cmdFile" + } + } -xd { + arg_read1 cmdDir -xd + if {![file exists $cmdDir]} { + exit1 "can't read $cmdDir" + } + } -xv { + set argv [lrange $argv 1 end] + set verbose 1 + puts "main: verbose on" + } default { + verbose "remaining args: $argv" + break ;# let user handle remaining args later + } +} + +###################################################################### +# determine and load rc file - has to be done now so that widgets +# can be affected +###################################################################### + +# if user has no $DOTDIR, fall back to home directory +if {![info exists env(DOTDIR)]} { + set env(DOTDIR) ~ +} +# catch bogus DOTDIR, otherwise glob will lose the bogus directory +# and it won't appear in the error msg +if {[catch {glob $env(DOTDIR)} dotdir]} { + exit1 "$env(DOTDIR)/.multixtermrc can't be found because $env(DOTDIR) doesn't exist or can't be read" +} +set rcFile $dotdir/.multixtermrc + +set fileTypes { + {{Multixterm Files} *.mxt} + {{All Files} *} +} + +proc openFile {{fn {}}} { + verbose "opening $fn" + if {[string equal $fn ""]} { + set fn [tk_getOpenFile \ + -initialdir $::cmdDir \ + -filetypes $::fileTypes \ + -title "multixterm file"] + if {[string match $fn ""]} return + } + uplevel #0 source [list $fn] + verbose "xtermNames = \"$::xtermNames\"" + verbose "xtermCmd = $::xtermCmd" +} + +if {[file exists $rcFile]} { + openFile $rcFile +} else { + verbose "$rcFile: not found" +} + +if {![string equal "" $argv]} { + if {[string equal $xtermNames ""]} { + set xtermNames $argv + } +} + +###################################################################### +# Describe and initialize some important globals +###################################################################### + +# ::activeList and ::activeArray both track which xterms to send +# (common) keystrokes to. Each element in activeArray is connected to +# the active menu. The list version is just a convenience making the +# send function easier/faster. + +set activeList {} + +# ::names is an array of xterm names indexed by process spawn ids. + +set names(x) "" +unset names(x) + +# ::xtermSid is an array of xterm spawn ids indexed by process spawn ids. +# ::xtermPid is an array of xterm pids indexed by process spawn id. + +###################################################################### +# create an xterm and establish connections +###################################################################### + +proc xtermStart {cmd name} { + verbose "starting new xterm running $cmd with name $name" + + ###################################################################### + # create pty for xterm + ###################################################################### + set pid [spawn -noecho -pty] + verbose "spawn -pty: pid = $pid, spawn_id = $spawn_id" + set sidXterm $spawn_id + stty raw -echo < $spawn_out(slave,name) + + regexp ".*(.)(.)" $spawn_out(slave,name) dummy c1 c2 + if {[string compare $c1 "/"] == 0} { + set c1 0 + } + + ###################################################################### + # prepare to start xterm by making sure xterm name is unique + # X doesn't care but active menu won't make sense unless names are unique + ###################################################################### + set unique 1 + foreach oldName [array names ::names] { + if {[string match "$name" $::names($oldName)]} { + set unique 0 + } + } + verbose "uniqueness of $name: $unique" + + set safe [safe $name] + + # if not unique, look at the numerical suffixes of all matching + # names, find the biggest and increment it + if {!$unique} { + set suffix 2 + foreach oldName [array names ::names] { + verbose "regexp ^[set safe](\[0-9]+)$ $::names($oldName) X num" + if {[regexp "^[set safe](\[0-9]+)$" $::names($oldName) X num]} { + verbose "matched, checking suffix" + if {$num >= $suffix} { + set suffix [expr $num+1] + verbose "new suffix: $suffix" + } + } + } + append name $suffix + verbose "new name: $name" + } + + ###################################################################### + # start new xterm + ###################################################################### + set xtermpid [eval exec xterm -name [list $name] -S$c1$c2$spawn_out(slave,fd) $::xtermArgs &] + verbose "xterm: pid = $xtermpid" + close -slave + + # xterm first sends back window id, save in environment so it can be + # passed on to the new process + log_user 0 + expect { + eof {wait;return} + -re (.*)\n { + # convert hex to decimal + # note quotes must be used here to avoid diagnostic from expr + set ::env(WINDOWID) [expr "0x$expect_out(1,string)"] + } + } + + ###################################################################### + # start new process + ###################################################################### + set pid [eval spawn -noecho $cmd] + verbose "$cmd: pid = $pid, spawn_id = $spawn_id" + set sidCmd $spawn_id + lappend ::activeList $sidCmd + set ::activeArray($sidCmd) 1 + + ###################################################################### + # link everything back to spawn id of new process + ###################################################################### + set ::xtermSid($sidCmd) $sidXterm + set ::names($sidCmd) $name + set ::xtermPid($sidCmd) $xtermpid + + ###################################################################### + # connect proc output to xterm output + # connect xterm input to proc input + ###################################################################### + expect_background { + -i $sidCmd + -re ".+" [list sendTo $sidXterm] + eof [list xtermKill $sidCmd] + -i $sidXterm + -re ".+" [list sendTo $sidCmd] + eof [list xtermKill $sidCmd] + } + + .m.e entryconfig Active -state normal + .m.e.active add checkbutton -label $name -variable activeArray($sidCmd) \ + -command [list xtermActiveUpdate $sidCmd] + set ::activeArray($sidCmd) 1 +} + +proc xtermActiveUpdate {sid} { + if {$::activeArray($sid)} { + verbose "activating $sid" + } else { + verbose "deactivating $sid" + } + activeListUpdate +} + +proc activeListUpdate {} { + set ::activeList {} + foreach n [array names ::activeArray] { + if {$::activeArray($n)} { + lappend ::activeList $n + } + } +} + +# make a string safe to go through regexp +proc safe {s} { + string map {{[} {\[} {*} {\*} {+} {\+} {^} {\^} {$} {\\$}} $s +} + +# utility to map xterm name to spawn id +# multixterm doesn't use this but a user might want to +proc xtermGet {name} { + foreach sid [array names ::names] { + if {[string equal $name $::names($sid)]} { + return $sid + } + } + error "no such term with name: $name" +} + +# utility to activate an xterm +# multixterm doesn't use this but a user might want to +proc xtermActivate {sid} { + set ::activeArray($sid) 1 + xtermActiveUpdate $sid +} + +# utility to deactivate an xterm +# multixterm doesn't use this but a user might want to +proc xtermDeactivate {sid} { + set ::activeArray($sid) 0 + xtermActiveUpdate $sid +} + +# utility to do an explicit Expect +# multixterm doesn't use this but a user might want to +proc xtermExpect {args} { + # check if explicit spawn_id in args + for {set i 0} {$i < [llength $args]} {incr i} { + switch -- [lindex $args $i] "-i" { + set sidCmd [lindex $args [incr i]] + break + } + } + + if {![info exists sidCmd]} { + # nothing explicit, so get it from the environment + + upvar spawn_id spawn_id + + # mimic expect's normal behavior in obtaining spawn_id + if {[info exists spawn_id]} { + set sidCmd $spawn_id + } else { + set sidCmd $::spawn_id + } + } + + # turn off bg expect, do fg expect, then re-enable bg expect + + expect_background -i $sidCmd ;# disable bg expect + eval expect $args ;# fg expect + ;# reenable bg expect + expect_background { + -i $sidCmd + -re ".+" [list sendTo $::xtermSid($sidCmd)] + eof [list xtermKill $sidCmd] + } +} + +###################################################################### +# connect main window keystrokes to all xterms +###################################################################### +proc xtermSend {A} { + if {[info exists ::afterId]} { + after cancel $::afterId + } + .input config -bg $::colorTyping + set ::afterId [after 1000 {.input config -bg $colorCurrent}] + + exp_send -raw -i $::activeList -- $A +} + +proc sendTo {to} { + exp_send -raw -i $to -- $::expect_out(buffer) +} + +# catch the case where there's no selection +proc xtermPaste {} {catch {xtermSend [selection get]}} + +###################################################################### +# clean up an individual process death or xterm death +###################################################################### +proc xtermKill {s} { + verbose "killing xterm $s" + + if {![info exists ::xtermPid($s)]} { + verbose "too late, already dead" + return + } + + catch {exec /bin/kill -9 $::xtermPid($s)} + unset ::xtermPid($s) + + # remove sid from activeList + verbose "removing $s from active array" + catch {unset ::activeArray($s)} + activeListUpdate + + verbose "removing from background handler $s" + catch {expect_background -i $s} + verbose "removing from background handler $::xtermSid($s)" + catch {expect_background -i $::xtermSid($s)} + verbose "closing proc" + catch {close -i $s} + verbose "closing xterm" + catch {close -i $::xtermSid($s)} + verbose "waiting on proc" + wait -i $s + wait -i $::xtermSid($s) + verbose "done waiting" + unset ::xtermSid($s) + + # remove from active menu + verbose "deleting active menu entry $::names($s)" + + # figure out which it is + # avoid using name as an index since we haven't gone to any pains to + # make it safely interpreted by index-pattern code. instead step + # through, doing the comparison ourselves + set last [.m.e.active index last] + # skip over tearoff + for {set i 1} {$i <= $last} {incr i} { + if {![catch {.m.e.active entrycget $i -label} label]} { + if {[string equal $label $::names($s)]} break + } + } + .m.e.active delete $i + unset ::names($s) + + # if none left, disable menu + # this leaves tearoff clone but that seems reasonable + if {0 == [llength [array names ::xtermSid]]} { + .m.e entryconfig Active -state disable + } +} + +###################################################################### +# create windows +###################################################################### +tk_setPalette $palette + +menu .m -tearoff 0 +.m add cascade -menu .m.f -label "File" -underline 0 +.m add cascade -menu .m.e -label "Edit" -underline 0 +.m add cascade -menu .m.help -label "Help" -underline 0 +set files [glob -nocomplain $cmdDir/*] +set filesLength [llength $files] +if {$filesLength >= $tearoffMenuMin} { + set filesTearoff 1 +} else { + set filesTearoff 0 +} +menu .m.f -tearoff $filesTearoff -title "multixterm files" +menu .m.e -tearoff 0 +menu .m.help -tearoff 0 +.m.f add command -label Open -command openFile -underline 0 + +if {$filesLength} { + .m.f add separator + set files [lsort $files] + set files [lrange $files 0 $fileMenuMax] + foreach f $files { + .m.f add command -label $f -command [list openFile $f] + } + .m.f add separator +} + +.m.f add command -label "Exit" -command exit -underline 0 +.m.e add command -label "Paste" -command xtermPaste -underline 0 +.m.e add cascade -label "Active" -menu .m.e.active -underline 0 +.m.help add command -label "About" -command about -underline 0 +.m.help add command -label "Man Page" -command help -underline 0 +. config -m .m + +menu .m.e.active -tearoff 1 -title "multixterm active" +.m.e entryconfig Active -state disabled +# disable the Active menu simply because it looks goofy seeing an empty menu +# for consistency, though, it should be enabled + +entry .input -textvar inputLabel -justify center -state disabled +entry .cmd -textvar xtermCmd +button .exec -text "new xterm" -command {xtermStart $xtermCmd $xtermCmd} + +grid .input -sticky ewns +grid .cmd -sticky ew +grid .exec -sticky ew -ipadx 3 -ipady 3 + +grid columnconfigure . 0 -weight 1 +grid rowconfigure . 0 -weight 1 ;# let input window only expand + +bind .cmd <Return> {xtermStart $xtermCmd $xtermCmd} + +# send all keypresses to xterm +bind .input <KeyPress> {xtermSend %A ; break} +bind .input <Alt-KeyPress> {xtermSend \033%A; break} +bind .input <Meta-KeyPress> {xtermSend \033%A; break} +bind .input <<Paste>> {xtermPaste ; break} +bind .input <<PasteSelection>> {xtermPaste ; break} + +# arrow keys - note that if they've been rebound through .Xdefaults +# you'll have to change these definitions. +bind .input <Up> {xtermSend \033OA; break} +bind .input <Down> {xtermSend \033OB; break} +bind .input <Right> {xtermSend \033OC; break} +bind .input <Left> {xtermSend \033OD; break} +# Strange: od -c reports these as \033[A et al but when keypad mode +# is initialized, they send \033OA et al. Presuming most people +# want keypad mode, I'll go with the O versions. Perhaps the other +# version is just a Sun-ism anyway. + +set colorCurrent [.input cget -bg] +set colorFocusOut $colorCurrent + +# change color to show focus +bind .input <FocusOut> colorFocusOut +bind .input <FocusIn> colorFocusIn +proc colorFocusIn {} {.input config -bg [set ::colorCurrent $::colorFocusIn]} +proc colorFocusOut {} {.input config -bg [set ::colorCurrent $::colorFocusOut]} + +# convert normal mouse events to focusIn +bind .input <1> {focus .input; break} +bind .input <Shift-1> {focus .input; break} + +# ignore all other mouse events that might make selection visible +bind .input <Double-1> break +bind .input <Triple-1> break +bind .input <B1-Motion> break +bind .input <B2-Motion> break + +set scriptName [info script] ;# must get while it's active + +proc about {} { + set w .about + if {[winfo exists $w]} { + wm deiconify $w + raise $w + return + } + toplevel $w + wm title $w "about multixterm" + wm iconname $w "about multixterm" + wm resizable $w 0 0 + + button $w.b -text Dismiss -command [list wm withdraw $w] + + label $w.title -text "multixterm" -font "Times 16" -borderwidth 10 -fg red + label $w.version -text "Version $::versionString, Released $::versionDate" + label $w.author -text "Written by Don Libes <don@libes.com>" + label $w.using -text "Using Expect [exp_version],\ + Tcl $::tcl_patchLevel,\ + Tk $::tk_patchLevel" + grid $w.title + grid $w.version + grid $w.author + grid $w.using + grid $w.b -sticky ew +} + +proc help {} { + if {[winfo exists .help]} { + wm deiconify .help + raise .help + return + } + toplevel .help + wm title .help "multixterm help" + wm iconname .help "multixterm help" + + scrollbar .help.sb -command {.help.text yview} + text .help.text -width 74 -height 30 -yscroll {.help.sb set} -wrap word + + button .help.ok -text Dismiss -command {destroy .help} -relief raised + bind .help <Return> {destroy .help;break} + grid .help.sb -row 0 -column 0 -sticky ns + grid .help.text -row 0 -column 1 -sticky nsew + grid .help.ok -row 1 -columnspan 2 -sticky ew -ipadx 3 -ipady 3 + + # let text box only expand + grid rowconfigure .help 0 -weight 1 + grid columnconfigure .help 1 -weight 1 + + set script [auto_execok $::scriptName] + if {[llength $script] == 0} { + set script /depot/tcl/bin/multixterm ;# fallback + } + if {[catch {open $script} fid]} { + .help.text insert end "Could not open help file: $script" + } else { + # skip to the beginning of the actual help (starts with "NAME") + while {-1 != [gets $fid buf]} { + if {1 == [regexp "NAME" $buf]} { + .help.text insert end "\n NAME\n" + break + } + } + + while {-1 != [gets $fid buf]} { + if {0 == [regexp "^#(.?)(.*)" $buf X key buf]} break + if {$key == "!"} { + set buf [subst -nocommands $buf] + set key " " + } + .help.text insert end $key$buf\n + } + } + + # support scrolling beyond Tk's built-in Next/Previous + foreach w {"" .sb .text .ok} { + set W .help$w + bind $W <space> {scrollPage 1} ;#more + bind $W <Delete> {scrollPage -1} ;#more + bind $W <BackSpace> {scrollPage -1} ;#more + bind $W <Control-v> {scrollPage 1} ;#emacs + bind $W <Meta-v> {scrollPage -1} ;#emacs + bind $W <Control-f> {scrollPage 1} ;#vi + bind $W <Control-b> {scrollPage -1} ;#vi + bind $W <F35> {scrollPage 1} ;#sun + bind $W <F29> {scrollPage -1} ;#sun + bind $W <Down> {scrollLine 1} + bind $W <Up> {scrollLine -1} + } +} + +proc scrollPage {dir} { + tkScrollByPages .help.sb v $dir + return -code break +} + +proc scrollLine {dir} { + tkScrollByUnits .help.sb v $dir + return -code break +} + +###################################################################### +# exit handling +###################################################################### + +# xtermKillAll is not intended to be user-callable. It just kills +# the processes and that's it. A user-callable version would update +# the data structures, close the channels, etc. + +proc xtermKillAll {} { + foreach sid [array names ::xtermPid] { + exec /bin/kill -9 $::xtermPid($sid) + } +} + +rename exit _exit +proc exit {{x 0}} {xtermKillAll;_exit $x} + +wm protocol . WM_DELETE_WINDOW exit +trap exit SIGINT + +###################################################################### +# start any xterms requested +###################################################################### +proc xtermStartAll {} { + verbose "xtermNames = \"$::xtermNames\"" + foreach n $::xtermNames { + regsub -all "%n" $::xtermCmd $n cmdOut + xtermStart $cmdOut $n + } + set ::xtermNames {} +} + +initLate + +# now that xtermStartAll and its accompanying support has been set up +# run it to start anything defined by rc file or command-line args. + +xtermStartAll ;# If nothing has been requested, this is a no-op. + +# finally do any explicit command file +if {[info exists cmdFile]} { + openFile $cmdFile +} + diff --git a/example/multixterm.man b/example/multixterm.man new file mode 100644 index 0000000..bc78522 --- /dev/null +++ b/example/multixterm.man @@ -0,0 +1,299 @@ +.TH MULTIXTERM 1 "16 August 2002" +.SH NAME +multixterm \- drive multiple xterms separately or together +.SH SYNOPSIS +.B multixterm +[ +.I args +] +.SH DESCRIPTION +Multixterm creates multiple xterms that can be driven together +or separately. + +In its simplest form, multixterm is run with no arguments and +commands are interactively entered in the first entry field. +Press return (or click the "new xterm" button) to create a new +xterm running that command. + +Keystrokes in the "stdin window" are redirected to all xterms +started by multixterm. xterms may be driven separately simply +by focusing on them. + +The stdin window must have the focus for keystrokes to be sent +to the xterms. When it has the focus, the color changes to +aquamarine. As characters are entered, the color changes to +green for a second. This provides feedback since characters +are not echoed in the stdin window. + +Typing in the stdin window while holding down the alt or meta +keys sends an escape character before the typed characters. +This provides support for programs such as emacs. + +.SH ARGUMENTS +.RS +.TP 4 +-xa +The optional \-xa argument indicates arguments to pass to +xterm. + +.TP +-xc +The optional \-xc argument indicates a command to be run in +each named xterm (see \-xn). With no \-xc argument, the command +is the current shell. + +.TP 4 +-xd +The optional \-xd argument indicates a directory to search for +files that will appear in the Files menu. By default, the +directory is: ~/lib/multixterm + +.TP 4 +-xf +The optional \-xf argument indicates a file to be read at +startup. See FILES below for more info. + +.TP 4 +-xn +The optional \-xn argument indicates a name for each xterm. +This name will also be substituted for any %n in the command +argument (see \-xc). + +.TP 4 +-xv +The optional \-xv flag puts multixterm into a verbose mode +where it will describe some of the things it is doing +internally. The verbose output is not intended to be +understandable to anyone but the author. + +.RE +Less common options may be changed by the startup file (see +FILES below). + +All the usual X and wish flags are supported (i.e., \-display, +\-name). There are so many of them that to avoid colliding and +make them easy to remember, all the multixterm flags begin +with \-x. + +If any arguments do not match the flags above, the remainder of the +command line is made available for user processing. By default, the +remainder is used as a list of xterm names in the style of \-xn. The +default behavior may be changed using the .multixtermrc file (see DOT +FILE below). + +.SH "EXAMPLE COMMAND LINE ARGUMENTS" +The following command line starts up two xterms using ssh to +the hosts bud and dexter. + + multixterm \-xc "ssh %n" bud dexter + +.SH FILES +Command files may be used to drive or initialize multixterm. +The File menu may be used to invoke other files. If files +exist in the command file directory (see \-xd above), they will +appear in the File menu. Files may also be loaded by using +File->Open. Any filename is acceptable but the File->Open +browser defaults to files with a .mxt suffix. + +Files are written in Tcl and may change any variables or +invoke any procedures. The primary variables of interest are 'xtermCmd' +which identifies the command (see \-xc) and 'xtermNames' +which is a list of names (see \-xn). The procedure +xtermStartAll, starts xterms for each name in the list. Other +variables and procedures may be discovered by examining +multixterm itself. + +.SH "EXAMPLE FILE" +The following file does the same thing as the earlier example +command line: +.nf + + # start two xterms connected to bud and dexter + set xtermCmd "ssh %n" + set xtermNames {bud dexter} + xtermStartAll + +.fi +.SH "DOT FILE" +At startup, multixterm reads ~/.multixtermrc if present. This +is similar to the command files (see FILES above) except +that .multixtermrc may not call xtermStartAll. Instead it is +called implicitly, similar to the way that it is implicit in +the command line use of \-xn. + +The following example .multixtermrc file makes every xterm run +ssh to the hosts named on the command line. + + set xtermCmd "ssh %n" + +Then multixterm could be called simply: + + multixterm bud dexter + +If any command-line argument does not match a multixterm flag, +the remainder of the command line is made available to .multixtermrc +in the argv variable. If argv is non-empty when .multixtermrc returns, it is assigned to xtermNames unless xtermNames is non-empty in which case, the +content of argv is ignored. + +Commands from multixterm are evaluated early in the +initialization of multixterm. Anything that must be done late +in the initialization (such as adding additional bindings to +the user interface) may be done by putting the commands inside +a procedure called "initLate". + +.SH MENUS +Except as otherwise noted, the menus are self-explanatory. +Some of the menus have dashed lines as the first entry. +Clicking on the dashed lines will "tear off" the menus. + +.SH "USAGE SUGGESTION \- ALIASES AND COMMAND FILES" +Aliases may be used to store lengthy command-line invocations. +Command files can be also be used to store such invocations +as well as providing a convenient way to share configurations. + +Tcl is a general-purpose language. Thus multixterm command +files can be extremely flexible, such as loading hostnames +from other programs or files that may change from day-to-day. +In addition, command files can be used for other purposes. +For example, command files may be used to prepared common +canned interaction sequences. For example, the command to +send the same string to all xterms is: + + xtermSend "a particularly long string" + +The File menu (torn-off) makes canned sequences particularly +convenient. Interactions could also be bound to a mouse button, +keystroke, or added to a menu via the .multixtermrc file. + +The following .multixtermrc causes tiny xterms to tile across +and down the screen. (You may have to adjust the parameters +for your screen.) This can be very helpful when dealing with +large numbers of xterms. +.nf + + set yPos 0 + set xPos 0 + + trace variable xtermArgs r traceArgs + + proc traceArgs {args} { + global xPos yPos + set ::xtermArgs "-geometry 80x12+$xPos+$yPos \-font 6x10" + if {$xPos} { + set xPos 0 + incr yPos 145 + if {$yPos > 800} {set yPos 0} + } else { + set xPos 500 + } + } +.fi + +The xtermArgs variable in the code above is the variable corresponding +to the \-xa argument. + +xterms can be also be created directly. The following command file +creates three xterms overlapped +horizontally: +.nf + + set xPos 0 + foreach name {bud dexter hotdog} { + set ::xtermArgs "-geometry 80x12+$xPos+0 \-font 6x10" + set ::xtermNames $name + xtermStartAll + incr xPos 300 + } + +.fi +.SH "USAGE SUGGESTION \- SELECTING HOSTS BY NICKNAME" +The following .multixtermrc shows an example of changing the +default handling of the arguments from hostnames to a filename +containing hostnames: + + set xtermNames [exec cat $argv] + +The following is a variation, retrieving the host names from +the yp database: + + set xtermNames [exec ypcat $argv] + +The following hardcodes two sets of hosts, so that you can +call multixterm with either "cluster1" or "cluster2": +.nf + + switch $argv { + cluster1 { + set xtermNames "bud dexter" + } + cluster2 { + set xtermNames "frank hotdog weiner" + } + } + +.fi + + +.SH COMPARE/CONTRAST +It is worth comparing multixterm to xkibitz. Multixterm +connects a separate process to each xterm. xkibitz connects +the same process to each xterm. + +.SH LIMITATIONS + +Multixterm provides no way to remotely control scrollbars, resize, and +most other window system related functions. + +Because xterm has no mechanism for propagating size information to +external processes, particularly for character graphic applications +(e.g., vi, emacs), you may have to manually ensure that the spawned +process behind each xterm has the correct size. For example, if you +create or set the xterm to a size, you may have to send an explicit +stty command with the correct size to the spawned process(es). +Alternatively, you can add the correct size argument when an xterm is +created (i.e., "-geometry 80x20"). + +Multixterm can only control new xterms that multixterm itself has +started. + +As a convenience, the File menu shows a limited number of +files. To show all the files, use File->Open. + +.SH FILES +$DOTDIR/.multixtermrc initial command file +.br +~/.multixtermrc fallback command file +.br +~/lib/multixterm/ default command file directory + +.SH BUGS +If multixterm is killed using an uncatchable kill, the xterms +are not killed. This appears to be a bug in xterm itself. + +Send/expect sequences can be done in multixterm command files. +However, due to the richness of the possibilities, to document +it properly would take more time than the author has at present. + +.SH REQUIREMENTS +Requires Expect 5.36.0 or later. +.br +Requires Tk 8.3.3 or later. + +.SH VERSION +This man page describes version 1.8 of multixterm. + +The latest version of multixterm is available from +http://expect.nist.gov/example/multixterm . If your version of Expect +and Tk are too old (see REQUIREMENTS above), download a new version of +Expect from http://expect.nist.gov + +.SH DATE +April 30, 2002 + +.SH AUTHOR +Don Libes <don@libes.com> + +.SH LICENSE +Multixterm is in the public domain; however the author would +appreciate acknowledgement if multixterm or parts of it or ideas from +it are used. diff --git a/example/passmass b/example/passmass new file mode 100755 index 0000000..e3c18e6 --- /dev/null +++ b/example/passmass @@ -0,0 +1,216 @@ +#!/bin/sh +# -*- tcl -*- +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh "$0" ${1+"$@"} + +package require Expect + + +# passmass: change password on many machines +# Synopsis: passmass host1 host2 host3 .... +# Don Libes - March 11, 1991 + +# Description: Change passwords on the named machines. +# +# See passmass.man for further info. + +exp_version -exit 5.0 + +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] + } +} + +# set defaults +set login "rlogin" +set program "passwd" +set user [exec whoami] +set su 0 + +set timeout -1 +stty -echo + +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 +} + +set timeout -1 + +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 + } "-ssh" { + set login "ssh" + 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 -nocase -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 -nocase "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 -nocase "password:" + send "$password(old)\r" + expect "# " + send "$program root\r" + } else { + send "$program\r" + } + + expect -nocase -re "(old|existing login) password:.*" { + send "$password(old)\r" + expect -nocase "sorry*" { + badhost $host "old password is bad?" + continue + } -nocase "password:" + } -nocase -re "new password:" { + # got prompt, fall through + } timeout { + badhost $host "could not recognize prompt for password" + continue + } + send "$password(new)\r" + expect -re "not changed|unchanged" { + badhost $host "new password is bad?" + continue + } -nocase -re "(password|verification|verify|again):.*" + send "$password(new)\r" + expect -nocase -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" +} diff --git a/example/passmass.man b/example/passmass.man new file mode 100644 index 0000000..dcaeccd --- /dev/null +++ b/example/passmass.man @@ -0,0 +1,106 @@ +.TH PASSMASS 1 "7 October 1993" +.SH NAME +passmass \- change password on multiple machines +.SH SYNOPSIS +.B passmass +[ +.I host1 host2 host3 ... +] +.SH INTRODUCTION +.B Passmass +changes a password on multiple machines. If you have accounts on +several machines that do not share password databases, Passmass can +help you keep them all in sync. This, in turn, will make it easier to +change them more frequently. + +When Passmass runs, it asks you for the old and new passwords. +(If you are changing root passwords and have equivalencing, the old +password is not used and may be omitted.) + +Passmass understands the "usual" conventions. Additional arguments +may be used for tuning. They affect all hosts which follow until +another argument overrides it. For example, if you are known as +"libes" on host1 and host2, but "don" on host3, you would say: + + passmass host1 host2 -user don host3 + +Arguments are: +.RS +.TP 4 +-user +User whose password will be changed. By default, the current user is used. + +.TP 4 +-rlogin +Use rlogin to access host. (default) + +.TP 4 +-slogin +Use slogin to access host. + +.TP 4 +-ssh +Use ssh to access host. + +.TP 4 +-telnet +Use telnet to access host. + +.TP 4 +-program + +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 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 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 + +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 +11"x13" piece of paper on which he had listed accounts and passwords +all across the Internet. This was several years worth of careful work +and he carried it with him everywhere he went. +Well one day, he forgot to remove it from his jeans, and we found a +perfectly blank sheet of paper when we took out the wash the following +day! +.SH SEE ALSO +.I +"Exploring Expect: A Tcl-Based Toolkit for Automating Interactive Programs" +\fRby Don Libes, +O'Reilly and Associates, January 1995. +.SH AUTHOR +Don Libes, National Institute of Standards and Technology diff --git a/example/passwd.cgi b/example/passwd.cgi new file mode 100644 index 0000000..f6756e9 --- /dev/null +++ b/example/passwd.cgi @@ -0,0 +1,106 @@ +#!/depot/path/expect -- + +# This is a CGI script to process requests created by the accompanying +# passwd.html form. This script is pretty basic, although it is +# reasonably robust. (Purposely intent users can make the script bomb +# by mocking up their own HTML form, however they can't expose or steal +# passwords or otherwise open any security holes.) This script doesn't +# need any special permissions. The usual (ownership nobody) is fine. +# +# With a little more code, the script can do much more exotic things - +# for example, you could have the script: +# +# - telnet to another host first (useful if you run CGI scripts on a +# firewall), or +# +# - change passwords on multiple password server hosts, or +# +# - verify that passwords aren't in the dictionary, or +# +# - verify that passwords are at least 8 chars long and have at least 2 +# digits, 2 uppercase, 2 lowercase, or whatever restrictions you like, +# or +# +# - allow short passwords by responding appropriately to passwd +# +# and so on. Have fun! +# +# Don Libes, NIST + +puts "Content-type: text/html\n" ;# note extra newline + +puts " +<head> +<title>Passwd Change Acknowledgment</title> +</head> + +<h2>Passwd Change Acknowledgment</h2> +" + +proc cgi2ascii {buf} { + regsub -all {\+} $buf { } buf + regsub -all {([\\["$])} $buf {\\\1} buf + regsub -all -nocase "%0d%0a" $buf "\n" buf + regsub -all -nocase {%([a-f0-9][a-f0-9])} $buf {[format %c 0x\1]} buf + eval return \"$buf\" +} + +foreach pair [split [read stdin $env(CONTENT_LENGTH)] &] { + regexp (.*)=(.*) $pair dummy varname val + set val [cgi2ascii $val] + set var($varname) $val +} + +log_user 0 + +proc errormsg {s} {puts "<h3>Error: $s</h3>"} +proc successmsg {s} {puts "<h3>$s</h3>"} + +# Need to su first to get around passwd's requirement that passwd cannot +# be run by a totally unrelated user. Seems rather pointless since it's +# so easy to satisfy, eh? + +# Change following line appropriately for your site. +# (We use yppasswd, but you might use something else.) +spawn /bin/su $var(name) -c "/bin/yppasswd $var(name)" +# This fails on SunOS 4.1.3 (passwd says "you don't have a login name") +# run on (or telnet first to) host running SunOS 4.1.4 or later. + +expect { + "Unknown login:" { + errormsg "unknown user: $var(name)" + exit + } default { + errormsg "$expect_out(buffer)" + exit + } "Password:" +} +send "$var(old)\r" +expect { + "unknown user" { + errormsg "unknown user: $var(name)" + exit + } "Sorry" { + errormsg "Old password incorrect" + exit + } default { + errormsg "$expect_out(buffer)" + exit + } "Old password:" +} +send "$var(old)\r" +expect "New password:" +send "$var(new1)\r" +expect "New password:" +send "$var(new2)\r" +expect -re (.*)\r\n { + set error $expect_out(1,string) +} +close +wait + +if {[info exists error]} { + errormsg "$error" +} else { + successmsg "Password changed successfully." +} diff --git a/example/passwd.html b/example/passwd.html new file mode 100644 index 0000000..8d53a6c --- /dev/null +++ b/example/passwd.html @@ -0,0 +1,25 @@ +<HTML> +<head> +<title>Change your login password</title> +</head> +<body> + +This HTML creates a form for letting users change login passwords with +a browser. To actually use this form, install the corresponding +accompanying cgi script and then modify the action value to identify +where you put the cgi script. (Also read the comments at the +beginning of the CGI script.) - Don Libes +<hr> + +<form method=post +action="http://www-i.cme.nist.gov/cgi-bin/expect/passwd.cgi"> +<h2>Change your login password</h2> +<br>Username: <input name="name"> +<br>Old password: <input type=password name="old"> +<br>New password: <input type=password name="new1"> +<br>New password: <input type=password name="new2"> +<br>New password must be entered twice to avoid typos. +<br><input type=submit value="Change password"> +</form> +</body> +</html> diff --git a/example/passwdprompt b/example/passwdprompt new file mode 100755 index 0000000..163e493 --- /dev/null +++ b/example/passwdprompt @@ -0,0 +1,35 @@ +#!/depot/path/expect + +# This script prompts for a passwd from stdin while echoing *'s + +# Prompt MUST be passed as argument to avoid falling into the classic +# prompt-before-echo-has-been-disabled mistake. + +proc getpass {prompt} { + set sttyOld [stty -echo raw] + send_user $prompt + + set timeout -1 + set passwd "" + + expect { + -re "\r" { + send_user \r\n + } -re "\010|\177" { + if {[string length $passwd] > 0} { + # not all ttys support destructive spaces + send "\010 \010" + regexp (.*). $passwd x passwd + } + exp_continue + } -re . { + send_user * + append passwd $expect_out(0,string) + exp_continue + } + } + eval stty $sttyOld + return $passwd +} + +puts "The password you entered was: [getpass "Password: "]" diff --git a/example/read1char b/example/read1char new file mode 100644 index 0000000..43a3df8 --- /dev/null +++ b/example/read1char @@ -0,0 +1,13 @@ +#!/bin/sh +# -*- tcl -*- +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh "$0" ${1+"$@"} + +package require Expect + +# read a single character +# Author: Don Libes, NIST + +stty raw +expect ? +send_user $expect_out(buffer) diff --git a/example/reprompt b/example/reprompt new file mode 100644 index 0000000..02db985 --- /dev/null +++ b/example/reprompt @@ -0,0 +1,20 @@ +#!/depot/path/expect -- + +# Name: reprompt +# Description: reprompt every so often until user enters something +# Usage: reprompt timeout prompt +# Author: Don Libes, NIST + +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) + } +} diff --git a/example/rftp b/example/rftp new file mode 100755 index 0000000..c5db679 --- /dev/null +++ b/example/rftp @@ -0,0 +1,341 @@ +#!/bin/sh +# -*- tcl -*- +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh "$0" ${1+"$@"} + +package require Expect + +# rftp - ftp a directory hierarchy (i.e. recursive ftp) +# Version 2.10 +# Don Libes, NIST +exp_version -exit 5.0 + +# rftp is much like ftp except that the command ~g copies everything in +# the remote current working directory to the local current working +# directory. Similarly ~p copies in the reverse direction. ~l just +# lists the remote directories. + +# rftp takes an argument of the host to ftp to. Username and password +# are prompted for. Other ftp options can be set interactively at that +# time. If your local ftp understands .netrc, that is also used. + +# ~/.rftprc is sourced after the user has logged in to the remote site +# and other ftp commands may be sent at that time. .rftprc may also be +# used to override the following rftp defaults. The lines should use +# the same syntax as these: + +set file_timeout 3600 ;# timeout (seconds) for retrieving files +set timeout 1000000 ;# timeout (seconds) for other ftp dialogue +set default_type binary ;# default type, i.e., ascii, binary, tenex +set binary {} ;# files matching are transferred as binary +set ascii {} ;# as above, but as ascii +set tenex {} ;# as above, but as tenex + +# The values of binary, ascii and tenex should be a list of (Tcl) regular +# expressions. For example, the following definitions would force files +# ending in *.Z and *.tar to be transferred as binaries and everything else +# as text. + +# set default_type ascii +# set binary {*.Z *.tar} + +# If you are on a UNIX machine, you can probably safely ignore all of this +# and transfer everything as "binary". + +# The current implementation requires that the source host be able to +# provide directory listings in UNIX format. Hence, you cannot copy +# from a VMS host (although you can copy to it). In fact, there is no +# standard for the output that ftp produces, and thus, ftps that differ +# significantly from the ubiquitous UNIX implementation may not work +# with rftp (at least, not without changing the scanning and parsing). + +####################end of documentation############################### + +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]] + } +} + +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>*" +} + +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>*" +} + +# 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 +} + +# 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*$name*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" + } +} + +proc getentry {name type transfer} { + 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) + + 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) + + 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 + + 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> " +} + +if {[file readable ~/.rftprc]} {source ~/.rftprc} +set first_time 1 + +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} +interact -echo ~g { + 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 +} -echo ~l { + getcurdirectory 0 + final_msg +} diff --git a/example/rlogin-cwd b/example/rlogin-cwd new file mode 100755 index 0000000..b217373 --- /dev/null +++ b/example/rlogin-cwd @@ -0,0 +1,21 @@ +#!/bin/sh +# -*- tcl -*- +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh "$0" ${1+"$@"} + +package require Expect + + +# rlogin-cwd - rlogin but with same directory +# +# You can extend this idea to save any arbitrary information across rlogin +# Don Libes - Oct 17, 1991. + +set prompt "(%|#|\\$) $" ;# default prompt +catch {set prompt $env(EXPECT_PROMPT)} + +eval spawn rlogin $argv +set timeout 60 +expect eof exit timeout {send_user "timed out\n"; exit} -re $prompt +send "cd [pwd]\r" +interact diff --git a/example/robohunt b/example/robohunt new file mode 100755 index 0000000..853ce1e --- /dev/null +++ b/example/robohunt @@ -0,0 +1,87 @@ +#!/bin/sh +# -*- tcl -*- +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh "$0" ${1+"$@"} + +package require Expect + + +# Synopsis +# robohunt player-name [-nodisplay] + +# Plays hunt automatically. Optional "-nodisplay" argument disables output. + +# by Don Libes + +expect_version -exit 5.0 + +set timeout 1 + +proc random {} { + 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 + } +} + +# 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 +} + +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:" +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)} +} diff --git a/example/rogue.exp b/example/rogue.exp new file mode 100755 index 0000000..083acdf --- /dev/null +++ b/example/rogue.exp @@ -0,0 +1,23 @@ +#!/bin/sh +# -*- tcl -*- +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh "$0" ${1+"$@"} + +package require Expect + +# Look for a GREAT game of rogue. +# 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 +} +interact diff --git a/example/telnet-cwd b/example/telnet-cwd new file mode 100755 index 0000000..bd16048 --- /dev/null +++ b/example/telnet-cwd @@ -0,0 +1,19 @@ +#!/bin/sh +# -*- tcl -*- +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh "$0" ${1+"$@"} + +package require Expect + +# telnet-cwd - telnet but with same directory +# +# You can extend this idea to save any arbitrary information across telnet +# Don Libes - Oct 17, 1991. + +set prompt "(%|#|\\$) $" ;# default prompt +catch {set prompt $env(EXPECT_PROMPT)} + +eval spawn telnet $argv +interact -o -nobuffer -re $prompt return +send "cd [pwd]\r" +interact diff --git a/example/telnet-in-bg b/example/telnet-in-bg new file mode 100644 index 0000000..1aecfef --- /dev/null +++ b/example/telnet-in-bg @@ -0,0 +1,18 @@ +# Start telnet and when you press ^Z, put telnet in background and save any +# remaining output in "telnet.log". You can actually apply this technique +# to any interactive program - I just chose telnet here. + +# 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 +disconnect + +set log [open logfile w] ;# open logfile +expect -re .+ { ;# and record everything to it + puts -nonewline $log $expect_out(buffer) + exp_continue +} + diff --git a/example/term_expect b/example/term_expect new file mode 100755 index 0000000..2abecfd --- /dev/null +++ b/example/term_expect @@ -0,0 +1,602 @@ +#!/depot/path/expectk + +# Name: tkterm - terminal emulator using Expect and Tk text widget, v3.0 +# Author: Don Libes, July '94 +# Last updated: Mar '04 + +# This is primarily for regression testing character-graphic applications. +# You can certainly use it as a terminal emulator - however many features +# in a real terminal emulator are not supported (although I'll probably +# add some of them later). + +# A paper on the implementation: Libes, D., Automation and Testing of +# Interactive Character Graphic Programs", Software - Practice & +# Experience, John Wiley & Sons, West Sussex, England, Vol. 27(2), +# p. 123-137, February 1997. + +############################### +# Quick overview of this emulator +############################### +# Very good attributes: +# Understands both termcap and terminfo +# Understands meta-key (zsh, emacs, etc work) +# Is fast +# Understands X selections +# Looks best with fixed-width font but doesn't require it +# Supports scrollbars +# Good-enough-for-starters attributes: +# Understands one kind of standout mode (reverse video) +# Should-be-fixed-soon attributes: +# Does not support resize +# Probably-wont-be-fixed-soon attributes: +# Assumes only one terminal exists + +############################################### +# To try out this package, just run it. Using it in +# your scripts is simple. Here are directions: +############################################### +# 0) make sure Expect is linked into your Tk-based program (or vice versa) +# 1) modify the variables/procedures below these comments appropriately +# 2) source this file +# 3) pack the text widget ($term) if you have so configured it (see +# "term_alone" below). As distributed, it packs into . automatically. + +############################################# +# Variables that must be initialized before using this: +############################################# +set rows 24 ;# number of rows in term +set rowsDumb $rows ;# number of rows in term when in dumb mode - this can + ;# increase during runtime +set cols 80 ;# number of columns in term +set term .t ;# name of text widget used by term +set sb .sb ;# name of scrollbar used by term in dumb mode +set term_alone 1 ;# if 1, directly pack term into . + ;# else you must pack +set termcap 1 ;# if your applications use termcap +set terminfo 1 ;# if your applications use terminfo + ;# (you can use both, but note that + ;# starting terminfo is slow) +set term_shell $env(SHELL) ;# program to run in term + +############################################# +# Readable variables of interest +############################################# +# cur_row ;# current row where insert marker is +# cur_col ;# current col where insert marker is +# term_spawn_id ;# spawn id of term + +############################################# +# Procs you may want to initialize before using this: +############################################# + +# term_exit is called if the spawned process exits +proc term_exit {} { + exit +} + +# term_chars_changed is called after every change to the displayed chars +# You can use if you want matches to occur in the background (a la bind) +# If you want to test synchronously, then just do so - you don't need to +# redefine this procedure. +proc term_chars_changed {} { +} + +# term_cursor_changed is called after the cursor is moved +proc term_cursor_changed {} { +} + +# Example tests you can make +# +# Test if cursor is at some specific location +# if {$cur_row == 1 && $cur_col == 0} ... +# +# Test if "foo" exists anywhere in line 4 +# if {[string match *foo* [$term get 4.0 4.end]]} +# +# Test if "foo" exists at line 4 col 7 +# if {[string match foo* [$term get 4.7 4.end]]} +# +# Test if a specific character at row 4 col 5 is in standout +# if {-1 != [lsearch [$term tag names 4.5] standout]} ... +# +# Return contents of screen +# $term get 1.0 end +# +# Return indices of first string on lines 4 to 6 that is in standout mode +# $term tag nextrange standout 4.0 6.end +# +# Replace all occurrences of "foo" with "bar" on screen +# for {set i 1} {$i<=$rows} {incr i} { +# regsub -all "foo" [$term get $i.0 $i.end] "bar" x +# $term delete $i.0 $i.end +# $term insert $i.0 $x +# } + +############################################# +# End of things of interest +############################################# + +# Terminal definitions are provided in both termcap and terminfo +# styles because we cannot be sure which a system might have. The +# definitions generally follow that of xterm which in turn follows +# that of vt100. This is useful for the most common archaic software +# which has vt100 definitions hardcoded. + +unset env(DISPLAY) +set env(LINES) $rows +set env(COLUMNS) $cols + +if {$termcap} { + set env(TERM) "tt" + set env(TERMCAP) {tt: + :ks=\E[?1h\E: + :ke=\E[?1l\E>: + :cm=\E[%d;%dH: + :up=\E[A: + :nd=\E[C: + :cl=\E[H\E[J: + :ce=\E[K: + :do=^J: + :so=\E[7m: + :se=\E[m: + :k1=\EOP: + :k2=\EOQ: + :k3=\EOR: + :k4=\EOS: + :k5=\EOT: + :k6=\EOU: + :k7=\EOV: + :k8=\EOW: + :k9=\EOX: + } +} + +if {$terminfo} { + # ncurses ignores 2-char term names so use a longer name here + set env(TERM) "tkterm" + set env(TERMINFO) /tmp + set ttsrc "/tmp/tt.src" + set file [open $ttsrc w] + + puts $file {tkterm|Don Libes' tk text widget terminal emulator, + smkx=\E[?1h\E, + rmkx=\E[?1l\E>, + cup=\E[%p1%d;%p2%dH, + cuu1=\E[A, + cuf1=\E[C, + clear=\E[H\E[J, + el=\E[K, + ind=\n, + cr=\r, + smso=\E[7m, + rmso=\E[m, + kf1=\EOP, + kf2=\EOQ, + kf3=\EOR, + kf4=\EOS, + kf5=\EOT, + kf6=\EOU, + kf7=\EOV, + kf8=\EOW, + kf9=\EOX, + } + close $file + + set oldpath $env(PATH) + 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 + } + set env(PATH) $oldpath + + exec rm $ttsrc +} + +set term_standout 0 ;# if in standout mode or not + +log_user 0 + +# start a shell and text widget for its output +set stty_init "-tabs" +eval spawn $term_shell +stty rows $rows columns $cols < $spawn_out(slave,name) +set term_spawn_id $spawn_id + +# this shouldn't be needed if Ousterhout fixes text bug +text $term \ + -yscroll "$sb set" \ + -relief sunken -bd 1 -width $cols -height $rows -wrap none -setgrid 1 + +# define scrollbars +scrollbar .sb -command "$term yview" + +proc graphicsGet {} {return $::graphics(mode)} +proc graphicsSet {mode} { + set ::graphics(mode) $mode + + if {$mode} { + # in graphics mode, no scroll bars + grid forget $::sb + } else { + grid $::sb -column 0 -row 0 -sticky ns + } +} + +if {$term_alone} { + grid $term -column 1 -row 0 -sticky nsew + # let text box only expand + grid rowconfigure . 0 -weight 1 + grid columnconfigure . 1 -weight 1 +} + +$term tag configure standout -background black -foreground white + +proc term_clear {} { + global term + + $term delete 1.0 end + term_init +} + +# pine is the only program I know that requires clear_to_eol, sigh +proc term_clear_to_eol {} { + global cols cur_col cur_row + + # save current col/row + set col $cur_col + set row $cur_row + + set space_rem_on_line [expr $cols - $cur_col] + term_insert [format %[set space_rem_on_line]s ""] + + # restore current col/row + set cur_col $col + set cur_row $row +} + +proc term_init {} { + global rows cols cur_row cur_col term + + # initialize it with blanks to make insertions later more easily + set blankline [format %*s $cols ""]\n + for {set i 1} {$i <= $rows} {incr i} { + $term insert $i.0 $blankline + } + + set cur_row 1 + set cur_col 0 + + $term mark set insert $cur_row.$cur_col + + set ::rowsDumb $rows +} + +proc term_down {} { + global cur_row rows cols term + + if {$cur_row < $rows} { + incr cur_row + } else { + if {[graphicsGet]} { + # in graphics mode + + # already at last line of term, so scroll screen up + $term delete 1.0 "1.end + 1 chars" + + # recreate line at end + $term insert end [format %*s $cols ""]\n + } else { + # in dumb mode + incr cur_row + + if {$cur_row > $::rowsDumb} { + set ::rowsDumb $cur_row + } + + $term insert $cur_row.0 [format %*s $cols ""]\n + $term see $cur_row.0 + } + } +} + +proc term_up {} { + global cur_row rows cols term + + set cur_rowOld $cur_row + incr cur_row -1 + + if {($cur_rowOld > $rows) && ($cur_rowOld == $::rowsDumb)} { + if {[regexp "^ *$" [$::term get $cur_rowOld.0 $cur_rowOld.end]]} { + # delete line + $::term delete $cur_rowOld.0 end + } + incr ::rowsDumb -1 + } +} + +proc term_insert {s} { + global cols cur_col cur_row + global term term_standout + + set chars_rem_to_write [string length $s] + set space_rem_on_line [expr $cols - $cur_col] + + if {$term_standout} { + set tag_action "add" + } else { + set tag_action "remove" + } + + ################## + # write first line + ################## + + if {$chars_rem_to_write > $space_rem_on_line} { + set chars_to_write $space_rem_on_line + set newline 1 + } else { + set chars_to_write $chars_rem_to_write + set newline 0 + } + + $term delete $cur_row.$cur_col $cur_row.[expr $cur_col + $chars_to_write] + $term insert $cur_row.$cur_col [ + string range $s 0 [expr $space_rem_on_line-1] + ] + + $term tag $tag_action standout $cur_row.$cur_col $cur_row.[expr $cur_col + $chars_to_write] + + # discard first line already written + incr chars_rem_to_write -$chars_to_write + set s [string range $s $chars_to_write end] + + # update cur_col + incr cur_col $chars_to_write + # update cur_row + if {$newline} { + term_down + } + + ################## + # write full lines + ################## + while {$chars_rem_to_write >= $cols} { + $term delete $cur_row.0 $cur_row.end + $term insert $cur_row.0 [string range $s 0 [expr $cols-1]] + $term tag $tag_action standout $cur_row.0 $cur_row.end + + # discard line from buffer + set s [string range $s $cols end] + incr chars_rem_to_write -$cols + + set cur_col 0 + term_down + } + + ################# + # write last line + ################# + + if {$chars_rem_to_write} { + $term delete $cur_row.0 $cur_row.$chars_rem_to_write + $term insert $cur_row.0 $s + $term tag $tag_action standout $cur_row.0 $cur_row.$chars_rem_to_write + set cur_col $chars_rem_to_write + } + + term_chars_changed +} + +proc term_update_cursor {} { + global cur_row cur_col term + + $term mark set insert $cur_row.$cur_col + + term_cursor_changed +} + +term_init +graphicsSet 0 + +set flush 0 +proc screen_flush {} { + global flush + incr flush + if {$flush == 24} { + update idletasks + set flush 0 + } +} + +expect_background { + -i $term_spawn_id + -re "^\[^\x01-\x1f]+" { + # Text + term_insert $expect_out(0,string) + term_update_cursor + } "^\r" { + # (cr,) Go to beginning of line + screen_flush + set cur_col 0 + term_update_cursor + } "^\n" { + # (ind,do) Move cursor down one line + term_down + term_update_cursor + } "^\b" { + # Backspace nondestructively + incr cur_col -1 + term_update_cursor + } "^\a" { + bell + } "^\t" { + # Tab, shouldn't happen + send_error "got a tab!?" + } eof { + term_exit + } "^\x1b\\\[A" { + # (cuu1,up) Move cursor up one line + term_up + term_update_cursor + } "^\x1b\\\[C" { + # (cuf1,nd) Non-destructive space + incr cur_col + term_update_cursor + } -re "^\x1b\\\[(\[0-9]*);(\[0-9]*)H" { + # (cup,cm) Move to row y col x + set cur_row [expr $expect_out(1,string)+1] + set cur_col $expect_out(2,string) + term_update_cursor + } "^\x1b\\\[H\x1b\\\[J" { + # (clear,cl) Clear screen + term_clear + term_update_cursor + } "^\x1b\\\[K" { + # (el,ce) Clear to end of line + term_clear_to_eol + term_update_cursor + } "^\x1b\\\[7m" { + # (smso,so) Begin standout mode + set term_standout 1 + } "^\x1b\\\[m" { + # (rmso,se) End standout mode + set term_standout 0 + } "^\x1b\\\[?1h\x1b" { + # (smkx,ks) start keyboard-transmit mode + # terminfo invokes these when going in/out of graphics mode + graphicsSet 1 + } "^\x1b\\\[?1l\x1b>" { + # (rmkx,ke) end keyboard-transmit mode + graphicsSet 0 + } +} + +bind $term <Any-Enter> { + focus %W +} + +bind $term <Meta-KeyPress> { + if {"%A" != ""} { + exp_send -i $term_spawn_id "\033%A" + } +} + +bind $term <KeyPress> { + exp_send -i $term_spawn_id -- %A + break +} + +bind $term <Control-space> {exp_send -null} +bind $term <Control-at> {exp_send -null} + +bind $term <F1> {exp_send -i $term_spawn_id "\033OP"} +bind $term <F2> {exp_send -i $term_spawn_id "\033OQ"} +bind $term <F3> {exp_send -i $term_spawn_id "\033OR"} +bind $term <F4> {exp_send -i $term_spawn_id "\033OS"} +bind $term <F5> {exp_send -i $term_spawn_id "\033OT"} +bind $term <F6> {exp_send -i $term_spawn_id "\033OU"} +bind $term <F7> {exp_send -i $term_spawn_id "\033OV"} +bind $term <F8> {exp_send -i $term_spawn_id "\033OW"} +bind $term <F9> {exp_send -i $term_spawn_id "\033OX"} + +set term_counter 0 +proc term_expect {args} { + upvar timeout localTimeout + upvar #0 timeout globalTimeout + set timeout 10 + catch {set timeout $globalTimeout} + catch {set timeout $localTimeout} + + global term_counter + incr term_counter + global [set strobe _data_[set term_counter]] + global [set tstrobe _timer_[set term_counter]] + + proc term_chars_changed {} "uplevel #0 set $strobe 1" + + set $strobe 1 + set $tstrobe 0 + + if {$timeout >= 0} { + set mstimeout [expr 1000*$timeout] + after $mstimeout "set $strobe 1; set $tstrobe 1" + set timeout_act {} + } + + set argc [llength $args] + if {$argc%2 == 1} { + lappend args {} + incr argc + } + + for {set i 0} {$i<$argc} {incr i 2} { + set act_index [expr $i+1] + if {[string compare timeout [lindex $args $i]] == 0} { + set timeout_act [lindex $args $act_index] + set args [lreplace $args $i $act_index] + incr argc -2 + break + } + } + + while {![info exists act]} { + if {![set $strobe]} { + tkwait var $strobe + } + set $strobe 0 + + if {[set $tstrobe]} { + set act $timeout_act + } else { + for {set i 0} {$i<$argc} {incr i 2} { + if {[uplevel [lindex $args $i]]} { + set act [lindex $args [incr i]] + break + } + } + } + } + + proc term_chars_changed {} {} + + if {$timeout >= 0} { + after $mstimeout unset $strobe $tstrobe + } else { + unset $strobe $tstrobe + } + + set code [catch {uplevel $act} string] + if {$code > 4} {return -code $code $string} + if {$code == 4} {return -code continue} + if {$code == 3} {return -code break} + if {$code == 2} {return -code return} + if {$code == 1} {return -code error -errorinfo $errorInfo \ + -errorcode $errorCode $string} + return $string +} + +################################################## +# user-supplied code goes below here +################################################## + +set timeout 200 + +# for example, wait for a shell prompt +term_expect {regexp "%" [$term get 1.0 3.end]} + +# invoke game of rogue +exp_send "myrogue\r" + +# wait for strength of 18 +term_expect \ + {regexp "Str: 18" [$term get 24.0 24.end]} { + # do something + } {timeout} { + puts "ulp...timed out!" + } {regexp "Str: 16" [$term get 24.0 24.end]} + +# and so on... + diff --git a/example/timed-read b/example/timed-read new file mode 100755 index 0000000..8e63f0f --- /dev/null +++ b/example/timed-read @@ -0,0 +1,12 @@ +#!/bin/sh +# -*- tcl -*- +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh "$0" ${1+"$@"} + +package require Expect + +# read a complete line from stdin +# aborting after the number of seconds (given as an argument) +# - Don Libes +set timeout $argv +expect -re \n {send_user $expect_out(buffer)} diff --git a/example/timed-run b/example/timed-run new file mode 100755 index 0000000..80def48 --- /dev/null +++ b/example/timed-run @@ -0,0 +1,13 @@ +#!/bin/sh +# -*- tcl -*- +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh "$0" ${1+"$@"} + +package require Expect + +# run a program for a given amount of time +# i.e. time 20 long_running_program + +set timeout [lindex $argv 0] +eval spawn [lrange $argv 1 end] +expect diff --git a/example/tknewsbiff b/example/tknewsbiff new file mode 100755 index 0000000..9a2da4b --- /dev/null +++ b/example/tknewsbiff @@ -0,0 +1,521 @@ +#!/bin/sh +# -*- tcl -*- +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh "$0" ${1+"$@"} + +package require Expect +package require Tk + +# Name: tknewsbiff +# Author: Don Libes +# Version: 1.2b +# Written: January 1, 1994 + +# Description: When unread news appears in your favorite groups, pop up +# a little window describing which newsgroups and how many articles. +# Go away when articles are no longer unread. +# Optionally, run a UNIX program (to play a sound, read news, etc.) + +# Default config file in ~/.tknewsbiff[-host] + +# These two procedures are needed because Tk provides no command to undo +# the "wm unmap" command. You must remember whether it was iconic or not. +# PUBLIC +proc unmapwindow {} { + global _window_open + + switch [wm state .] \ + iconic { + set _window_open 0 + } normal { + set _window_open 1 + } + wm withdraw . +} +unmapwindow +# window state starts out as "iconic" before it is mapped, Tk bug? +# make sure that when we map it, it will be open (i.e., "normal") +set _window_open 1 + +# PUBLIC +proc mapwindow {} { + global _window_open + + if {$_window_open} { + wm deiconify . + } else { + wm iconify . + } +} + +proc _abort {msg} { + global argv0 + + puts "$argv0: $msg" + exit 1 +} + +if {[info exists env(DOTDIR)]} { + set home $env(DOTDIR) +} else { + set home [glob ~] +} + +set delay 60 +set width 27 +set height 10 +set _default_config_file $home/.tknewsbiff +set _config_file $_default_config_file +set _default_server news +set server $_default_server +set server_timeout 60 + +log_user 0 + +listbox .list -yscroll ".scrollbar set" -font "*-m-*" -setgrid 1 +scrollbar .scrollbar -command ".list yview" -relief raised +.list config -highlightthickness 0 -border 0 +.scrollbar config -highlightthickness 0 +pack .scrollbar -side left -fill y +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]]} { + set active_file $arg + set argv [lrange $argv 1 end] + } else { + # must be a config file + set _config_file $arg + set argv [lrange $argv 1 end] + } + } elseif {[file readable $_config_file-$arg]} { + # maybe it's a hostname suffix for a newsrc file? + set _config_file $_default_config_file-$arg + set argv [lrange $argv 1 end] + } else { + # maybe it's just a hostname for regular newsrc file? + set server $arg + set argv [lrange $argv 1 end] + } +} + +proc _read_config_file {} { + global _config_file argv0 watch_list ignore_list + + # remove previous user-provided proc in case user simply + # deleted it from config file + proc user {} {} + + set watch_list {} + set ignore_list {} + + if {[file exists $_config_file]} { + # uplevel allows user to set global variables + if {[catch {uplevel source $_config_file} msg]} { + _abort "error reading $_config_file\n$msg" + } + } + + if {[llength $watch_list]==0} { + watch * + } +} + +# PUBLIC +proc watch {args} { + global watch_list + + lappend watch_list $args +} + +# PUBLIC +proc ignore {ng} { + global ignore_list + + lappend ignore_list $ng +} + +# 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]} { + set newsrc $home/.newsrc-$server + if {![file readable $newsrc]} { + set newsrc $home/.newsrc + if {![file readable $newsrc]} { + _abort "cannot tell what newgroups you read +found neither $home/.newsrc-$server nor $home/.newsrc" + } + } +} + +# PRIVATE +proc _read_newsrc {} { + global db newsrc + + 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]} { + set db($ng,seen) $seen + } + # only way 2nd regexp can fail is on lines + # that have a : but no number + } + close $file +} + +proc _unknown_host {} { + global server _default_server + + if {0==[string compare $_default_server $server]} { + puts "tknewsbiff: default server <$server> is not known" + } else { + puts "tknewsbiff: server <$server> is not known" + } + + puts "Give tknewsbiff an argument - either the name of your news server +or active file. I.e., + + tknewsbiff news.nist.gov + tknewsbiff /usr/news/lib/active + +If you have a correctly defined configuration file (.tknewsbiff), +an argument is not required. See the man page for more info." + exit 1 +} + +# read active file +# PRIVATE +proc _read_active {} { + global db server active_list active_file + upvar #0 server_timeout timeout + + set active_list {} + + if {[info exists active_file]} { + spawn -open [open $active_file] + } else { + spawn telnet $server nntp + expect { + "20*\n" { + # should get 200 or 201 + } "NNTP server*\n" { + puts "tknewsbiff: unexpected response from server:" + puts "$expect_out(buffer)" + return 1 + } "unknown host" { + _unknown_host + } timeout { + close + wait + return 1 + } eof { + # loadav too high probably + wait + return 1 + } + } + exp_send "list\r" + expect "list\r\n" ;# ignore echo of "list" command + expect -re "215\[^\n]*\n" ;# skip "Newsgroups in form" line + } + + expect { + -re "(\[^ ]*) 0*(\[^ ]+) \[^\n]*\n" { + set ng $expect_out(1,string) + set hi $expect_out(2,string) + lappend active_list $ng + set db($ng,hi) $hi + exp_continue + } + ".\r\n" close + ".\r\r\n" close + timeout close + eof + } + + wait + return 0 +} + +# test in various ways for good newsgroups +# return 1 if good, 0 if not good +# 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} + + # 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} + } + + # skip if we've seen it before + 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 +} + +# return 1 if not seen on previous turn +# PRIVATE +proc _isnew {ng} { + global previous_seen_list + + if {[lsearch -exact $previous_seen_list $ng]==-1} { + return 1 + } else { + return 0 + } +} + +# schedule display of newsgroup in global variable "newsgroup" +# PUBLIC +proc display {} { + global display_list newsgroup + + lappend display_list $newsgroup +} + +# PRIVATE +proc _update_ngs {} { + global watch_list active_list newsgroup + + foreach watch $watch_list { + set threshold 1 + set display display + set new {} + + set ngpat [lindex $watch 0] + set watch [lrange $watch 1 end] + + while {[llength $watch] > 0} { + switch -- [lindex $watch 0] \ + -threshold { + set threshold [lindex $watch 1] + set watch [lrange $watch 2 end] + } -display { + set display [lindex $watch 1] + set watch [lrange $watch 2 end] + } -new { + set new [lindex $watch 1] + set watch [lrange $watch 2 end] + } default { + _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]} { + set newsgroup $ng + uplevel $display + } + if {[_isnew $ng]} { + if {[llength $new]} { + set newsgroup $ng + uplevel $new + } + } + } + } + } + } +} + +# initialize display + +set min_reasonable_width 8 + +wm minsize . $min_reasonable_width 1 +wm maxsize . 999 999 +if {0 == [info exists active_file] && + 0 != [string compare $server $_default_server]} { + wm title . "news@$server" + wm iconname . "news@$server" +} + +# PRIVATE +proc _update_window {} { + global server display_list height width min_reasonable_width + + if {0 == [llength $display_list]} { + unmapwindow + return + } + + # make height correspond to length of display_list or + # user's requested max height, whichever is smaller + + if {[llength $display_list] < $height} { + set current_height [llength $display_list] + } else { + set current_height $height + } + + # force reasonable min width + if {$width < $min_reasonable_width} { + set width $min_reasonable_width + } + + wm geometry . ${width}x$current_height + wm maxsize . 999 [llength $display_list] + + _display_ngs $width + + if {[string compare [wm state .] withdrawn]==0} { + mapwindow + } +} + +# actually write all newsgroups to the window +# PRIVATE +proc _display_ngs {width} { + global db display_list + + set str_width [expr $width-7] + + .list delete 0 end + foreach ng $display_list { + .list insert end [format \ + "%-$str_width.${str_width}s %5d" $ng \ + [expr $db($ng,hi) - $db($ng,seen)]] + } +} + +# PUBLIC +proc help {} { + catch {destroy .help} + toplevel .help + message .help.text -aspect 400 -text \ +{tknewsbiff - written by Don Libes, NIST, 1/1/94 + +tknewsbiff displays newsgroups with unread articles based on your .newsrc\ +and your .tknewsbiff files.\ +If no articles are unread, no window is displayed. + +Click mouse button 1 for this help,\ +button 2 to force display to query news server immediately,\ +and button 3 to remove window from screen until the next update. + +Example .tknewsbiff file:} + message .help.sample -font "*-r-normal-*-m-*" \ + -relief raised -aspect 10000 -text \ +{set width 30 ;# max width, defaults to 27 +set height 17 ;# max height, defaults to 10 +set delay 120 ;# in seconds, defaults to 60 +set server news.nist.gov ;# defaults to "news" +set server_timeout 60 ;# in seconds, defaults to 60 +set newsrc ~/.newsrc ;# defaults to ~/.newsrc + ;# after trying ~/.newsrc-$server +# Groups to watch. +watch comp.lang.tcl +watch dc.dining -new "play yumyum" +watch nist.security -new "exec red-alert" +watch nist.* +watch dc.general -threshold 5 +watch *.sources.* -threshold 20 +watch alt.howard-stern -threshold 100 -new "play robin" + +# Groups to ignore (but which match patterns above). +# Note: newsgroups that you don't read are ignored automatically. +ignore *.d +ignore nist.security +ignore nist.sport + +# Change background color of newsgroup list +.list config -bg honeydew1 + +# Play a sound file +proc play {sound} { + exec play /usr/local/lib/sounds/$sound.au +}} + message .help.end -aspect 10000 -text \ +"Other customizations are possible. See man page for more information." + + button .help.ok -text "ok" -command {destroy .help} + pack .help.text + pack .help.sample + pack .help.end -anchor w + pack .help.ok -fill x -padx 2 -pady 2 +} + +spawn cat -u; set _cat_spawn_id $spawn_id +set _update_flag 0 + +# PUBLIC +proc update-now {} { + global _update_flag _cat_spawn_id + + if {$_update_flag} return ;# already set, do nothing + set _update_flag 1 + + exp_send -i $_cat_spawn_id "\r" +} + +bind .list <1> help +bind .list <2> update-now +bind .list <3> unmapwindow +bind .list <Configure> { + scan [wm geometry .] "%%dx%%d" w h + _display_ngs $w +} + +# PRIVATE +proc _sleep {timeout} { + global _cat_spawn_id _update_flag + + set _update_flag 0 + + # restore to idle cursor + .list config -cursor ""; update + + # sleep for a little while, subject to click from "update" button + expect -i $_cat_spawn_id -re "...." ;# two crlfs + + # change to busy cursor + .list config -cursor watch; update +} + +set previous_seen_list {} +set seen_list {} + +# PRIVATE +proc _init_ngs {} { + global display_list db + global seen_list previous_seen_list + + set previous_seen_list $seen_list + + set display_list {} + set seen_list {} + + catch {unset db} +} + +for {} {1} {_sleep $delay} { + _init_ngs + + _read_newsrc + if {[_read_active]} continue + _read_config_file + + _update_ngs + user + _update_window +} diff --git a/example/tknewsbiff.man b/example/tknewsbiff.man new file mode 100644 index 0000000..dc5d4ad --- /dev/null +++ b/example/tknewsbiff.man @@ -0,0 +1,412 @@ +.TH TKNEWSBIFF 1 "1 January 1994" +.SH NAME +tknewsbiff \- pop up a window when news appears +.SH SYNOPSIS +.B tknewsbiff +[ +.I server or config-file +] +.br +.SH INTRODUCTION +.B tknewsbiff +pops up a window when there is unread news in your favorite newsgroups +and removes the window after you've read the news. tknewsbiff can +optionally play a sound, start your newsreader, etc. + +.SH SELECTING NEWSGROUPS + +By default, the configuration file ~/.tknewsbiff describes how +tknewsbiff behaves. The syntax observes the usual Tcl rules +- however, even if you don't know Tcl, all but the most esoteric +configurations will be obvious. + +Each newsgroup (or set of newsgroups) to be watched is described by +using the "watch" command. For example: + +.nf + +watch dc.dining +watch nist.* +watch comp.unix.wizard -threshold 3 +watch *.sources.* -threshold 20 + +.fi + +For each newsgroup pattern, any newsgroup that matches it and which +you are subscribed to (according to your newsrc file) is eligible for +reporting. By default, tknewsbiff reports on the newsgroup if there +is at least one unread article. The "-threshold" flag changes the +threshold to the following number. For example, "-threshold 3" means +there must be at least three articles unread before tknewsbiff will +report the newsgroup. + +If no watch commands are given (or no configuration file exists), all +groups which are subscribed to are watched. + +To suppress newsgroups that would otherwise be reported, use the +"ignore" command. For example, the following matches all comp.* and +nist.* newgroups except for nist.posix or .d (discussion) groups: + +.nf + +watch comp.* +watch nist.* +ignore nist.posix.* +ignore *.d + +.fi + +The flag "-new" describes a command to be executed when the newsgroup +is first reported as having unread news. For example, the following +lines invoke the UNIX command "play" to play a sound. + +.nf + +watch dc.dining -new "exec play /usr/local/sounds/yumyum.au" +watch rec.auto* -new "exec play /usr/local/sounds/vroom.au" + +.fi + +You can cut down on the verbosity of actions by defining procedures. +For example, if you have many -new flags that all play sound files, +you could define a sound procedure. This would allow the -new +specification to be much shorter. + +.nf + +proc play {sound} { + exec play /usr/local/sounds/$sound.au +} + +watch dc.dining -new "play yumyum" +watch rec.auto* -new "play vroom" + +.fi + +As an aside, you can put an "&" at the end of an "exec" command to get +commands to execute asynchronously. However, it's probably not a good +idea to do this when playing sound files anyway. + +"newsgroup" is a read-only variable which contains the name of the +newsgroup that is being reported. This is useful when the action is +triggered by a pattern. For example, the following line could run the +newsgroup name through a speech synthesizer: + +.nf + +watch * -new { + exec play herald.au + exec speak "New news has arrived in $newsgroup." +} + +.fi + +The flag "\-display" describes a command to be executed every time the +newsgroup is reported as having unread news. The special command +"display" is the default command. It schedules $newsgroup to be +written to tknewsbiff's display when it is rewritten. For example, by +explicitly providing a -display flag that omits the display command, +you can disable the display of newsgroups that are already reported +via -new. + +.nf + +watch dc.dining -new {exec play yumyum.au} -display {} + +.fi + +If you want to execute an action repeatedly and +.I still +display the newsgroup in the default manner, +explicitly invoke the display command via the -display flag. For example: + +.nf + +watch *security* -display { + exec play red-alert.au + display +} + +.fi + +Actions associated with the -new and -display flags are executed only +once for each matching newsgroup. The command executed is the one +associated with the first pattern in the configuration file that +matches and observes the given threshold. + +Any command that is simply listed in the configuration file is +executed each time before the update loop in tknewsbiff. The reserved +(but user-defined) procedure "user" is run immediately after the +newsgroups are scheduled to be written to the display and before they +are actually written. + +For example, suppose unread articles appear in several rec.auto groups +and you play the same sound for each one. To prevent playing the +sound several times in a row, make the -new command simply set a flag. +In the user procedure, play the sound if the flag is set (and then +reset the flag). + +The user procedure could also be used to start a newsreader. This +would avoid the possibility of starting multiple newsreaders just +because multiple newsgroups contained unread articles. (A check +should, of course, be made to make sure that a newsreader is not +already running.) + +.SH MORE VARIABLES + +The following example lines show variables that can affect the +behavior of tknewsbiff + +.nf + +set delay 120 +set server news.nist.gov +set server_timeout 60 +set newsrc ~/.newsrc +set width 40 +set height 20 +set active_file /usr/news/lib/active + +.fi + +tknewsbiff alternates between checking for unread news and +sleeping (kind of like many undergraduates). The "delay" variable +describes how many seconds to sleep. + +The "server" variable names an NNTP news-server. +The default is "news". The "server" variable is +only used if the "active_file" variable is not set. + +The "server_timeout" variable describes how how many seconds to wait +for a response from the server before giving up. -1 means wait +forever or until the server itself times out. The default is 60 +seconds. + +The "newsrc" variable describes the name of your .newsrc file. By +default, tknewsbiff looks in your home directory for a newsrc file. A +server-specific newsrc is used if found. For example, if you have set +server to "cubit.nist.gov", then tknewsbiff looks for +~/.newsrc-cubit.nist.gov. (This is the Emacs gnus convention - which +is very convenient when you read news from multiple servers.) If +there is no server-specific newsrc, tknewsbiff uses ~/.newsrc. + +The "width" variable describes the width that tknewsbiff will use to +display information. If any newsgroup names are long enough, they +will be truncated so that the article counts can still be shown. You +can manually resize the window to see what was truncated. However, if +your configuration file sets the width variable, the window will be +restored to that size the next time that tknewsbiff checks for unread +news and updates its display. + +The "height" variable describes the maximum height that tknewsbiff +will use to display information. If fewer newsgroups are reported, +tknewsbiff will shrink the window appropriately. You can manually +resize the window but if your configuration file sets the height +variable, the window will be restored to that size the next time that +tknewsbiff checks for unread news and updates its display. + +The "active_file" variable describes the name of the news active file. +If set, the active file is read directly in preference to using NNTP +(even if the "server" variable is set). This is particularly useful +for testing out new configuration files since you can edit a fake +active file and then click button 2 to immediately see how tknewsbiff +responds (see BUTTONS below). + +If the environment variable DOTDIR is set, then its value is used as a +directory in which to find all dotfiles instead of from the home +directory. In particular, this affects the tknewsbiff configuration +file and the .newsrc file (assuming the newsrc variable is not set +explicitly). + +.SH WATCHING DIFFERENT NEWS SERVERS + +To watch multiple servers, run tknewsbiff multiple times. (Since you +need different .newsrc files and the servers have different newsgroups +and article numbers anyway, there is no point in trying to do this in +a single process.) + +You can point tknewsbiff at a different server with an appropriate +argument. The argument is tried both as a configuration file name and +as a suffix to the string "~/.tknewsbiff-". So if you want to watch +the server "kidney", store the tknewsbiff configuration information in +~/.tknewsbiff-kidney". The following two commands will both use that +configuration file. + +.nf + + tknewsbiff kidney + tknewsbiff ~/.tknewsbiff-kidney + +.fi + +In both cases, the actual server to contact is set by the value of the +server variable in the configuration file. + +If no configuration file is found, the argument is used as the server +to contact. This allows tknewsbiff to be run with no preparation +whatsoever. + +If the argument is the special keyword "active" (or ends in +"/active"), it is used as the name of an active file. This is in turn +used to initialize the variable "active_file" so that tknewsbiff reads +from the active file directly rather than using NNTP. + +Creating your own active file is a convenient way of testing your +configuration file. For example, after running the following command, +you can repeatedly edit your active file and trigger the update-now +command (either by pressing button 2 or setting the delay variable +very low) to see how tknewsbiff responds. + +The active file must follow the format of a real active file. The +format is one newsgroup per line. After the newsgroup name is the +number of the highest article, the lowest article. Lastly is the +letter y or m. m means the newsgroup is moderated. y means posting +is allowed. + +.SH WINDOW + +When unread news is found, a window is popped up. The window lists +the names of the newsgroups and the number of unread articles in each +(unless suppressed by the -display flag). When there is no longer any +unread news, the window disappears (although the process continues to +run). + +.SH BUTTONS + +Button or key bindings may be assigned by bind commands. Feel free to +change them. The default bind commands are: + +.nf + +bind .list <1> help +bind .list <2> update-now +bind .list <3> unmapwindow + +.fi + +By default button 1 (left) is bound to "help". The help command +causes tknewsbiff to pop up a help window. + +By default, button 2 (middle) is bound to "update-now". The update-now +command causes tknewsbiff to immediately check for unread news. If +your news server is slow or maintains a very large number of +newsgroups, or you have a large number of patterns in your +configuration file, tknewsbiff can take considerable time before +actually updating the window. + +By default, button 3 (right) is bound to "unmapwindow". The +unmapwindow command causes tknewsbiff to remove the window from the +display until the next time it finds unread news. (The mapwindow +command causes tknewsbiff to restore the window.) + +As an example, here is a binding to pop up an xterm and run rn when +you hold down the shift key and press button 1 in the listing window. + +.nf + +bind .list <Shift-1> { + exec xterm -e rn & +} + +.fi + +Here is a similar binding. However it tells rn to look only at the +newsgroup that is under the mouse when you pressed it. (The +"display_list" variable is described later in this man page.) + +.nf + +bind .list <Shift-1> { + exec xterm -e rn [lindex $display_list [.list nearest %y]] & +} + +.fi + +.SH OTHER COMMANDS AND VARIABLES + +Built-in commands already mentioned are: watch, ignore, display, help, +update-now, unmapwindow, and mapwindow. + +Any Tcl and Tk command can also be given. In particular, the list of +newsgroups is stored in the list widget ".list", and the scroll bar is +stored in the scrollbar widget ".scroll". So for example, if you want +to change the foreground and background colors of the newsgroup list, +you can say: + +.nf + + .list config -bg honeydew1 -fg orchid2 + +.fi + +These can also be controlled by the X resource database as well. +However, the configuration file allows arbitrarily complex commands to +be evaluated rather than simple assignments. + +Certain Tcl/Tk commands can disrupt proper function of tknewsbiff. +These will probably be obvious to anyone who knows enough to give +these commands in the first place. As a simple example, the program +assumes the font in the list box is of fixed width. The newsgroups +will likely not align if you use a variable-width font. + +The following variables are accessible and can be used for esoteric +uses. All other variables are private. Private variables and +commands begin with "_" so you don't need to worry about accidental +collisions. + +The array "db" is a database which maintains information about read +and unread news. db($newsgroup,hi) is the highest article that +exists. db($newsgroup,seen) is the highest article that you have +read. + +A number of lists maintain interesting information. "active_list" is a +list of known newsgroups. "seen_list" is a list of newsgroups that +have been seen so far as the -new and -display flags are being +processed. "previous_seen_list" is "seen_list" from the previous +cycle. "ignore_list" is the list of newsgroup patterns to ignore. +"watch_list" is the list of newsgroup patterns to watch. +"display_list" is the list of newsgroup will be displayed at the next +opportunity. + +.SH UPDATING YOUR FILES + +tknewsbiff automatically rereads your configuration file each time it +wakes up to check for unread news. To force tknewsbiff to reread the +file immediately (such as if you are testing a new configuration or +have just modified your newsrc file), press button 2 in the display +(see BUTTONS above). + +.SH CAVEATS + +tknewsbiff defines the number of unread articles as the highest +existing article minus the highest article that you've read. So if +you've read the last article in the newsgroup but no others, +tknewsbiff thinks there are no unread articles. (It's impossible to +do any better by reading the active file and it would be very time +consuming to do this more accurately via NNTP since servers provide no +efficient way of reporting their own holes in the newsgroups.) +Fortunately, this definition is considered a feature by most people. +It allows you to read articles and then mark them "unread" but not +have tknewsbiff continue telling you that they are unread. + +.SH UNWARRANTED CONCERNS + +Your news administrator may wonder if many people using tknewsbiff +severely impact an NNTP server. In fact, the impact is negligible +even when the delay is very low. To gather all the information it +needs, tknewsbiff uses a single NNTP query - it just asks for the +active file. The NNTP server does no computation, formatting, etc, it +just sends the file. All the interesting processing happens locally +in the tknewsbiff program itself. + +.SH BUGS + +The man page is longer than the program. + +.SH SEE ALSO +.I +"Exploring Expect: A Tcl-Based Toolkit for Automating Interactive Programs" +\fRby Don Libes, +O'Reilly and Associates, January 1995. +.SH AUTHOR +Don Libes, National Institute of Standards and Technology diff --git a/example/tkpasswd b/example/tkpasswd new file mode 100755 index 0000000..376c56a --- /dev/null +++ b/example/tkpasswd @@ -0,0 +1,612 @@ +#!/bin/sh +# -*- tcl -*- +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh "$0" ${1+"$@"} + +package require Expect +package require Tk + +# tkpasswd - Change passwords using Expectk +# Author: Don Libes, NIST, October 1, 1993 +# Version: 1.8 - Added support for Tk 4.1 + +# 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} { + return [llength [auto_execok $prog]] +} + +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 +pack .passwd -in .type -fill x + +if {[prog_exists yppasswd]} { + radiobutton .yppasswd -text yppasswd -variable passwd_cmd \ + -value {yppasswd {ypcat passwd}} \ + -anchor w -command get_users -relief flat + pack .yppasswd -in .type -fill x +} + +if {[prog_exists nispasswd]} { + radiobutton .nispasswd -text nispasswd -variable passwd_cmd \ + -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 +radiobutton .name -text name -variable sort_cmd -value "| sort" \ + -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 +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 {Courier 12 bold} -setgrid 1 +.names tag configure nopassword -relief raised +.names tag configure selection -relief raised + +set iscolor 0 +if {[winfo depth .] > 1} { + set iscolor 1 +} + +if {$iscolor} { + .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 +} +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 + +wm minsize . 14 1 +wm maxsize . 14 999 +wm geometry . 14x10 + +frame .password_frame -relief raised -bd 1 +entry .password -textvar password -relief sunken -width 1 +focus .password +bind .password <Return> password_set +label .prompt -text "Password:" -bd 0 +button .password_set -text "set" -command password_set +button .generate_button -text "generate" -command password_generate +pack .prompt .password -in .password_frame -fill x -padx 2 -pady 2 +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 +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 \ +"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.\ +(Press ^A to adjust the generation parameters.)\ +Press return to set the password.\ +If the dictionary is enabled and the password is in it,\ +the password is rejected. + +You must be root to set local passwords besides your own.\ +If you are not root, you must also enter an old password\ +when requested. + +You do not have to move mouse into password field(s) to enter password.\ +^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 +} + +# 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 +} + +proc feedback {msg} { + global password + + 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]} { + 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 +} + +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 + } +} + +# defaults for generating passwords +set length 9 +set minnum 2 +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 +} + +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 +} + +# insert char into password at a random position +proc insert {pvar char} { + upvar $pvar p + + 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] + } +} + +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 + } + } +} + +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." +} + + +# tell tab what window to move between +set parm_tabList {} + +# The procedure below is invoked in response to tabs in the entry +# windows. It moves the focus to the next window in the tab list. +# Arguments: +# +# list - Ordered list of windows to receive focus + +proc Tab {list} { + set i [lsearch $list [focus]] + if {$i < 0} { + set i 0 + } else { + incr i + if {$i >= [llength $list]} { + set i 0 + } + } + focus [lindex $list $i] +} + +# adjust args used in password generation +proc adjust_parameters {} { + 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 <tab> to move to the next entry.\ +Press <return> or click the <ok> 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> "Tab \$parm_tabList" + bind $w.$name.entry <Return> "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 +} + +# 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 +} + +# return appropriate ending for a count of "n" nouns +proc pluralize {n} { + 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 <Return> {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 +} + +proc select_next_nopassword {direction} { + global selection_line last_line 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 +} + +bind Text <1> {select %W %x,%y} +bind Text <Double-1> {select %W %x,%y} +bind Text <Triple-1> {select %W %x,%y} +bind Text <2> {select %W %x,%y} +bind Text <3> {select %W %x,%y} +bind Text <B1-Motion> {} +bind Text <Shift-1> {} +bind Text <Shift-B1-Motion> {} +bind Text <B2-Motion> {} + +bind .password <Control-n> {incr selection_line 1; make_selection} +bind .password <Control-p> {incr selection_line -1;make_selection} +bind .password <Meta-n> {select_next_nopassword 1} +bind .password <Meta-p> {select_next_nopassword -1} +bind .password <Control-g> {password_generate} +bind .password <Control-a> {adjust_parameters} +bind .password <Control-u> {set password ""} +bind Entry <Control-c> {exit} diff --git a/example/tkterm b/example/tkterm new file mode 100755 index 0000000..16ee972 --- /dev/null +++ b/example/tkterm @@ -0,0 +1,539 @@ +#!/bin/sh +# -*- tcl -*- +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh "$0" ${1+"$@"} + +package require Expect +package require Tk + +# Name: tkterm - terminal emulator using Expect and Tk text widget, v3.0 +# Author: Don Libes, July '94 +# Last updated: Mar '04 + +# This is primarily for regression testing character-graphic applications. +# You can certainly use it as a terminal emulator - however many features +# in a real terminal emulator are not supported (although I'll probably +# add some of them later). + +# A paper on the implementation: Libes, D., Automation and Testing of +# Interactive Character Graphic Programs", Software - Practice & +# Experience, John Wiley & Sons, West Sussex, England, Vol. 27(2), +# p. 123-137, February 1997. + +############################### +# Quick overview of this emulator +############################### +# Very good attributes: +# Understands both termcap and terminfo +# Understands meta-key (zsh, emacs, etc work) +# Is fast +# Understands X selections +# Looks best with fixed-width font but doesn't require it +# Supports scrollbars +# Good-enough-for-starters attributes: +# Understands one kind of standout mode (reverse video) +# Should-be-fixed-soon attributes: +# Does not support resize +# Probably-wont-be-fixed-soon attributes: +# Assumes only one terminal exists + +############################################### +# To try out this package, just run it. Using it in +# your scripts is simple. Here are directions: +############################################### +# 0) make sure Expect is linked into your Tk-based program (or vice versa) +# 1) modify the variables/procedures below these comments appropriately +# 2) source this file +# 3) pack the text widget ($term) if you have so configured it (see +# "term_alone" below). As distributed, it packs into . automatically. + +############################################# +# Variables that must be initialized before using this: +############################################# +set rows 24 ;# number of rows in term +set rowsDumb $rows ;# number of rows in term when in dumb mode - this can + ;# increase during runtime +set cols 80 ;# number of columns in term +set term .t ;# name of text widget used by term +set sb .sb ;# name of scrollbar used by term in dumb mode +set term_alone 1 ;# if 1, directly pack term into . + ;# else you must pack +set termcap 1 ;# if your applications use termcap +set terminfo 1 ;# if your applications use terminfo + ;# (you can use both, but note that + ;# starting terminfo is slow) +set term_shell $env(SHELL) ;# program to run in term + +############################################# +# Readable variables of interest +############################################# +# cur_row ;# current row where insert marker is +# cur_col ;# current col where insert marker is +# term_spawn_id ;# spawn id of term + +############################################# +# Procs you may want to initialize before using this: +############################################# + +# term_exit is called if the spawned process exits +proc term_exit {} { + exit +} + +# term_chars_changed is called after every change to the displayed chars +# You can use if you want matches to occur in the background (a la bind) +# If you want to test synchronously, then just do so - you don't need to +# redefine this procedure. +proc term_chars_changed {} { +} + +# term_cursor_changed is called after the cursor is moved +proc term_cursor_changed {} { +} + +# Example tests you can make +# +# Test if cursor is at some specific location +# if {$cur_row == 1 && $cur_col == 0} ... +# +# Test if "foo" exists anywhere in line 4 +# if {[string match *foo* [$term get 4.0 4.end]]} +# +# Test if "foo" exists at line 4 col 7 +# if {[string match foo* [$term get 4.7 4.end]]} +# +# Test if a specific character at row 4 col 5 is in standout +# if {-1 != [lsearch [$term tag names 4.5] standout]} ... +# +# Return contents of screen +# $term get 1.0 end +# +# Return indices of first string on lines 4 to 6 that is in standout mode +# $term tag nextrange standout 4.0 6.end +# +# Replace all occurrences of "foo" with "bar" on screen +# for {set i 1} {$i<=$rows} {incr i} { +# regsub -all "foo" [$term get $i.0 $i.end] "bar" x +# $term delete $i.0 $i.end +# $term insert $i.0 $x +# } + +############################################# +# End of things of interest +############################################# + +# Terminal definitions are provided in both termcap and terminfo +# styles because we cannot be sure which a system might have. The +# definitions generally follow that of xterm which in turn follows +# that of vt100. This is useful for the most common archaic software +# which has vt100 definitions hardcoded. + +unset env(DISPLAY) +set env(LINES) $rows +set env(COLUMNS) $cols + +if {$termcap} { + set env(TERM) "tt" + set env(TERMCAP) {tt: + :ks=\E[?1h\E: + :ke=\E[?1l\E>: + :cm=\E[%d;%dH: + :up=\E[A: + :nd=\E[C: + :cl=\E[H\E[J: + :ce=\E[K: + :do=^J: + :so=\E[7m: + :se=\E[m: + :k1=\EOP: + :k2=\EOQ: + :k3=\EOR: + :k4=\EOS: + :k5=\EOT: + :k6=\EOU: + :k7=\EOV: + :k8=\EOW: + :k9=\EOX: + } +} + +if {$terminfo} { + # ncurses ignores 2-char term names so use a longer name here + set env(TERM) "tkterm" + set env(TERMINFO) /tmp + set ttsrc "/tmp/tt.src" + set file [open $ttsrc w] + + puts $file {tkterm|Don Libes' tk text widget terminal emulator, + smkx=\E[?1h\E, + rmkx=\E[?1l\E>, + cup=\E[%p1%d;%p2%dH, + cuu1=\E[A, + cuf1=\E[C, + clear=\E[H\E[J, + el=\E[K, + ind=\n, + cr=\r, + smso=\E[7m, + rmso=\E[m, + kf1=\EOP, + kf2=\EOQ, + kf3=\EOR, + kf4=\EOS, + kf5=\EOT, + kf6=\EOU, + kf7=\EOV, + kf8=\EOW, + kf9=\EOX, + } + close $file + + set oldpath $env(PATH) + 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 + } + set env(PATH) $oldpath + + exec rm $ttsrc +} + +set term_standout 0 ;# if in standout mode or not + +log_user 0 + +# start a shell and text widget for its output +set stty_init "-tabs" +eval spawn $term_shell +stty rows $rows columns $cols < $spawn_out(slave,name) +set term_spawn_id $spawn_id + +# this shouldn't be needed if Ousterhout fixes text bug +text $term \ + -yscroll "$sb set" \ + -relief sunken -bd 1 -width $cols -height $rows -wrap none -setgrid 1 + +# define scrollbars +scrollbar .sb -command "$term yview" + +proc graphicsGet {} {return $::graphics(mode)} +proc graphicsSet {mode} { + set ::graphics(mode) $mode + + if {$mode} { + # in graphics mode, no scroll bars + grid forget $::sb + } else { + grid $::sb -column 0 -row 0 -sticky ns + } +} + +if {$term_alone} { + grid $term -column 1 -row 0 -sticky nsew + # let text box only expand + grid rowconfigure . 0 -weight 1 + grid columnconfigure . 1 -weight 1 +} + +$term tag configure standout -background black -foreground white + +proc term_clear {} { + global term + + $term delete 1.0 end + term_init +} + +# pine is the only program I know that requires clear_to_eol, sigh +proc term_clear_to_eol {} { + global cols cur_col cur_row + + # save current col/row + set col $cur_col + set row $cur_row + + set space_rem_on_line [expr $cols - $cur_col] + term_insert [format %[set space_rem_on_line]s ""] + + # restore current col/row + set cur_col $col + set cur_row $row +} + +proc term_init {} { + global rows cols cur_row cur_col term + + # initialize it with blanks to make insertions later more easily + set blankline [format %*s $cols ""]\n + for {set i 1} {$i <= $rows} {incr i} { + $term insert $i.0 $blankline + } + + set cur_row 1 + set cur_col 0 + + $term mark set insert $cur_row.$cur_col + + set ::rowsDumb $rows +} + +# NOT YET COMPLETE! +proc term_resize {rowsNew colsNew} { + global rows cols term + + foreach {set r 1} {$r < $rows} {incr r} { + if {$colsNew > $cols} { + # add columns + $term insert $i.$column $blanks + } elseif {$colsNew < $cols} { + # remove columns + # ? + } + } + + if {$rowsNew > $rows} { + # add rows + } elseis {$rowsNew < $rows} { + # remove rows + } +} + +proc term_down {} { + global cur_row rows cols term + + if {$cur_row < $rows} { + incr cur_row + } else { + if {[graphicsGet]} { + # in graphics mode + + # already at last line of term, so scroll screen up + $term delete 1.0 "1.end + 1 chars" + + # recreate line at end + $term insert end [format %*s $cols ""]\n + } else { + # in dumb mode + incr cur_row + + if {$cur_row > $::rowsDumb} { + set ::rowsDumb $cur_row + } + + $term insert $cur_row.0 [format %*s $cols ""]\n + $term see $cur_row.0 + } + } +} + +proc term_up {} { + global cur_row rows cols term + + set cur_rowOld $cur_row + incr cur_row -1 + + if {($cur_rowOld > $rows) && ($cur_rowOld == $::rowsDumb)} { + if {[regexp "^ *$" [$::term get $cur_rowOld.0 $cur_rowOld.end]]} { + # delete line + $::term delete $cur_rowOld.0 end + } + incr ::rowsDumb -1 + } +} + +proc term_insert {s} { + global cols cur_col cur_row + global term term_standout + + set chars_rem_to_write [string length $s] + set space_rem_on_line [expr $cols - $cur_col] + + if {$term_standout} { + set tag_action "add" + } else { + set tag_action "remove" + } + + ################## + # write first line + ################## + + if {$chars_rem_to_write > $space_rem_on_line} { + set chars_to_write $space_rem_on_line + set newline 1 + } else { + set chars_to_write $chars_rem_to_write + set newline 0 + } + + $term delete $cur_row.$cur_col $cur_row.[expr $cur_col + $chars_to_write] + $term insert $cur_row.$cur_col [ + string range $s 0 [expr $space_rem_on_line-1] + ] + + $term tag $tag_action standout $cur_row.$cur_col $cur_row.[expr $cur_col + $chars_to_write] + + # discard first line already written + incr chars_rem_to_write -$chars_to_write + set s [string range $s $chars_to_write end] + + # update cur_col + incr cur_col $chars_to_write + # update cur_row + if {$newline} { + term_down + } + + ################## + # write full lines + ################## + while {$chars_rem_to_write >= $cols} { + $term delete $cur_row.0 $cur_row.end + $term insert $cur_row.0 [string range $s 0 [expr $cols-1]] + $term tag $tag_action standout $cur_row.0 $cur_row.end + + # discard line from buffer + set s [string range $s $cols end] + incr chars_rem_to_write -$cols + + set cur_col 0 + term_down + } + + ################# + # write last line + ################# + + if {$chars_rem_to_write} { + $term delete $cur_row.0 $cur_row.$chars_rem_to_write + $term insert $cur_row.0 $s + $term tag $tag_action standout $cur_row.0 $cur_row.$chars_rem_to_write + set cur_col $chars_rem_to_write + } + + term_chars_changed +} + +proc term_update_cursor {} { + global cur_row cur_col term + + $term mark set insert $cur_row.$cur_col + + term_cursor_changed +} + +term_init +graphicsSet 0 + +set flush 0 +proc screen_flush {} { + global flush + incr flush + if {$flush == 24} { + update idletasks + set flush 0 + } +} + +expect_background { + -i $term_spawn_id + -re "^\[^\x01-\x1f]+" { + # Text + term_insert $expect_out(0,string) + term_update_cursor + } "^\r" { + # (cr,) Go to beginning of line + screen_flush + set cur_col 0 + term_update_cursor + } "^\n" { + # (ind,do) Move cursor down one line + term_down + term_update_cursor + } "^\b" { + # Backspace nondestructively + incr cur_col -1 + term_update_cursor + } "^\a" { + bell + } "^\t" { + # Tab, shouldn't happen + send_error "got a tab!?" + } eof { + term_exit + } "^\x1b\\\[A" { + # (cuu1,up) Move cursor up one line + term_up + term_update_cursor + } "^\x1b\\\[C" { + # (cuf1,nd) Non-destructive space + incr cur_col + term_update_cursor + } -re "^\x1b\\\[(\[0-9]*);(\[0-9]*)H" { + # (cup,cm) Move to row y col x + set cur_row [expr $expect_out(1,string)+1] + set cur_col $expect_out(2,string) + term_update_cursor + } "^\x1b\\\[H\x1b\\\[J" { + # (clear,cl) Clear screen + term_clear + term_update_cursor + } "^\x1b\\\[K" { + # (el,ce) Clear to end of line + term_clear_to_eol + term_update_cursor + } "^\x1b\\\[7m" { + # (smso,so) Begin standout mode + set term_standout 1 + } "^\x1b\\\[m" { + # (rmso,se) End standout mode + set term_standout 0 + } "^\x1b\\\[?1h\x1b" { + # (smkx,ks) start keyboard-transmit mode + # terminfo invokes these when going in/out of graphics mode + graphicsSet 1 + } "^\x1b\\\[?1l\x1b>" { + # (rmkx,ke) end keyboard-transmit mode + graphicsSet 0 + } +} + +# New and incomplete! +bind $term <Configure> { + scan [wm geometry .] "%dx%dx" rows cols + stty rows $rows columns $cols < $spawn_out(slave,name) + + # when this is working, uncomment ... + # term_resize $rows $cols +} + +bind $term <Any-Enter> { + focus %W +} + +bind $term <Meta-KeyPress> { + if {"%A" != ""} { + exp_send -i $term_spawn_id "\033%A" + } +} + +bind $term <KeyPress> { + exp_send -i $term_spawn_id -- %A + break +} + +bind $term <Control-space> {exp_send -null} +bind $term <Control-at> {exp_send -null} + +bind $term <F1> {exp_send -i $term_spawn_id "\033OP"} +bind $term <F2> {exp_send -i $term_spawn_id "\033OQ"} +bind $term <F3> {exp_send -i $term_spawn_id "\033OR"} +bind $term <F4> {exp_send -i $term_spawn_id "\033OS"} +bind $term <F5> {exp_send -i $term_spawn_id "\033OT"} +bind $term <F6> {exp_send -i $term_spawn_id "\033OU"} +bind $term <F7> {exp_send -i $term_spawn_id "\033OV"} +bind $term <F8> {exp_send -i $term_spawn_id "\033OW"} +bind $term <F9> {exp_send -i $term_spawn_id "\033OX"} diff --git a/example/unbuffer b/example/unbuffer new file mode 100755 index 0000000..ad5db7b --- /dev/null +++ b/example/unbuffer @@ -0,0 +1,31 @@ +#!/bin/sh +# -*- tcl -*- +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh "$0" ${1+"$@"} + +package require Expect + + +# -*- tcl -*- +# Description: unbuffer stdout of a program +# Author: Don Libes, NIST + +if {[string compare [lindex $argv 0] "-p"] == 0} { + # pipeline + set stty_init "-echo" + eval [list spawn -noecho] [lrange $argv 1 end] + close_on_eof -i $user_spawn_id 0 + interact { + eof { + # flush remaining output from child + expect -timeout 1 -re .+ + return + } + } +} else { + set stty_init "-opost" + set timeout -1 + eval [list spawn -noecho] $argv + expect + exit [lindex [wait] 3] +} diff --git a/example/unbuffer.c b/example/unbuffer.c new file mode 100644 index 0000000..d494bf8 --- /dev/null +++ b/example/unbuffer.c @@ -0,0 +1,13 @@ +/* unbuffer.c */ + +#include <stdio.h> +#include "expect.h" + +main(argc,argv) +int argc; +char *argv[]; +{ + argv++; + exp_timeout = -1; + exp_expectl(exp_spawnv(*argv,argv),exp_end); +} diff --git a/example/unbuffer.man b/example/unbuffer.man new file mode 100644 index 0000000..9e514cf --- /dev/null +++ b/example/unbuffer.man @@ -0,0 +1,82 @@ +.TH UNBUFFER 1 "1 June 1994" +.SH NAME +unbuffer \- unbuffer output +.SH SYNOPSIS +.B unbuffer +.I program +[ +.I args +] +.SH INTRODUCTION +.B unbuffer +disables the output buffering that occurs when program output +is redirected from non-interactive programs. +For example, suppose you are watching the output from a fifo by running it +through od and then more. +.nf + + od -c /tmp/fifo | more + +.fi +You will not see anything until a full page +of output has been produced. + +You can disable this automatic buffering as follows: + +.nf + + unbuffer od -c /tmp/fifo | more + +.fi +Normally, unbuffer does not read from stdin. This simplifies use of unbuffer in some situations. To use unbuffer in a pipeline, use the -p flag. +Example: +.nf + + process1 | unbuffer -p process2 | process3 +.fi +.SH CAVEATS + +unbuffer -p may appear to work incorrectly if a process feeding input +to unbuffer exits. Consider: +.nf + process1 | unbuffer -p process2 | process3 + +.fi +If process1 exits, process2 may not yet have finished. It is +impossible for unbuffer to know long to wait for process2 and process2 +may not ever finish, for example, if it is a filter. For expediency, +unbuffer simply exits when it encounters an EOF from either its input +or process2. + +In order to have a version of unbuffer that worked in all situations, +an oracle would be necessary. If you want an application-specific +solution, workarounds or hand-coded Expect may be more suitable. For +example, the following example shows how to allow grep to finish +processing when the cat before it finishes first. Using cat to feed +grep would never require unbuffer in real life. It is merely a +placeholder for some imaginary process that may or may not finish. +Similarly, the final cat at the end of the pipeline is also a +placeholder for another process. + +.nf + +$ cat /tmp/abcdef.log | grep abc | cat +abcdef +xxxabc defxxx +$ cat /tmp/abcdef.log | unbuffer grep abc | cat +$ (cat /tmp/abcdef.log ; sleep 1) | unbuffer grep abc | cat +abcdef +xxxabc defxxx +$ +.fi +.SH BUGS + +The man page is longer than the program. + +.SH SEE ALSO +.I +"Exploring Expect: A Tcl-Based Toolkit for Automating Interactive Programs" +\fRby Don Libes, +O'Reilly and Associates, January 1995. +.SH AUTHOR +Don Libes, National Institute of Standards and Technology diff --git a/example/virterm b/example/virterm new file mode 100755 index 0000000..bab254b --- /dev/null +++ b/example/virterm @@ -0,0 +1,639 @@ +#!/bin/sh +# -*- tcl -*- +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh "$0" ${1+"$@"} + +package require Expect + +# Name: virterm - terminal emulator using Expect, v1.0, December, 1994 +# Author: Adrian Mariano <adrian@cam.cornell.edu> +# +# Derived from Done Libes' tkterm + +# This is a program for interacting with applications that use terminal +# control sequences. It is a subset of Don Libes' tkterm emulator +# with a compatible interface so that programs can be written to work +# under both. +# +# Internally, it uses arrays instead of the Tk widget. Nonetheless, this +# code is not as fast as it should be. I need an Expect profiler to go +# any further. +# +# standout mode is not supported like it is in tkterm. +# the only terminal widget operation that is supported for the user +# is the "get" operation. +############################################### +# Variables that must be initialized before using this: +############################################# +set rows 24 ;# number of rows in term +set cols 80 ;# number of columns in term +set term myterm ;# name of text widget used by term +set termcap 1 ;# if your applications use termcap +set terminfo 0 ;# if your applications use terminfo + ;# (you can use both, but note that + ;# starting terminfo is slow) +set term_shell $env(SHELL) ;# program to run in term + +############################################# +# Readable variables of interest +############################################# +# cur_row ;# current row where insert marker is +# cur_col ;# current col where insert marker is +# term_spawn_id ;# spawn id of term + +############################################# +# Procs you may want to initialize before using this: +############################################# + +# term_exit is called if the associated proc exits +proc term_exit {} { + exit +} + +# term_chars_changed is called after every change to the displayed chars +# You can use if you want matches to occur in the background (a la bind) +# If you want to test synchronously, then just do so - you don't need to +# redefine this procedure. +proc term_chars_changed {} { +} + +# term_cursor_changed is called after the cursor is moved +proc term_cursor_changed {} { +} + +# Example tests you can make +# +# Test if cursor is at some specific location +# if {$cur_row == 1 && $cur_col == 0} ... +# +# Test if "foo" exists anywhere in line 4 +# if {[string match *foo* [$term get 4.0 4.end]]} +# +# Test if "foo" exists at line 4 col 7 +# if {[string match foo* [$term get 4.7 4.end]]} +# +# Return contents of screen +# $term get 1.0 end + +############################################# +# End of things of interest +############################################# + +set blankline "" +set env(LINES) $rows +set env(COLUMNS) $cols + +set env(TERM) "tt" +if {$termcap} { + set env(TERMCAP) {tt: + :cm=\E[%d;%dH: + :up=\E[A: + :cl=\E[H\E[J: + :do=^J: + :so=\E[7m: + :se=\E[m: + :nd=\E[C: + } +} + +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, + cup=\E[%p1%d;%p2%dH, + cuu1=\E[A, + cuf1=\E[C, + clear=\E[H\E[J, + ind=\n, + cr=\r, + smso=\E[7m, + rmso=\E[m, + } + close $file + + set oldpath $env(PATH) + set 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 + } + set env(PATH) $oldpath + + exec rm $ttsrc +} + +log_user 0 + +# start a shell and text widget for its output +set stty_init "-tabs" +eval spawn $term_shell +stty rows $rows columns $cols < $spawn_out(slave,name) +set term_spawn_id $spawn_id + +proc term_replace {reprow repcol text} { + global termdata + set middle $termdata($reprow) + set termdata($reprow) \ + [string range $middle 0 [expr $repcol-1]]$text[string \ + range $middle [expr $repcol+[string length $text]] end] +} + + +proc parseloc {input row col} { + upvar $row r $col c + global rows + switch -glob -- $input \ + end { set r $rows; set c end } \ + *.* { regexp (.*)\\.(.*) $input dummy r c + if {$r == "end"} { set r $rows } + } +} + +proc myterm {command first second args} { + global termdata + if {[string compare get $command]} { + send_error "Unknown terminal command: $command\r" + } else { + parseloc $first startrow startcol + parseloc $second endrow endcol + if {$endcol != "end"} {incr endcol -1} + if {$startrow == $endrow} { + set data [string range $termdata($startrow) $startcol $endcol] + } else { + set data [string range $termdata($startrow) $startcol end] + for {set i [expr $startrow + 1]} {$i < $endrow} {incr i} { + append data $termdata($i) + } + append data [string range $termdata($endrow) 0 $endcol] + } + return $data + } +} + + +proc scrollup {} { + global termdata blankline + for {set i 1} {$i < $rows} {incr i} { + set termdata($i) $termdata([expr $i+1]) + } + set termdata($rows) $blankline +} + + +proc term_init {} { + global rows cols cur_row cur_col term termdata blankline + + # initialize it with blanks to make insertions later more easily + set blankline [format %*s $cols ""]\n + for {set i 1} {$i <= $rows} {incr i} { + set termdata($i) "$blankline" + } + + set cur_row 1 + set cur_col 0 +} + + +proc term_down {} { + global cur_row rows cols term + + if {$cur_row < $rows} { + incr cur_row + } else { + scrollup + } +} + + +proc term_insert {s} { + global cols cur_col cur_row term + + set chars_rem_to_write [string length $s] + set space_rem_on_line [expr $cols - $cur_col] + + ################## + # write first line + ################## + + if {$chars_rem_to_write <= $space_rem_on_line} { + term_replace $cur_row $cur_col \ + [string range $s 0 [expr $space_rem_on_line-1]] + incr cur_col $chars_rem_to_write + term_chars_changed + return + } + + set chars_to_write $space_rem_on_line + set newline 1 + + term_replace $cur_row $cur_col\ + [string range $s 0 [expr $space_rem_on_line-1]] + + # discard first line already written + incr chars_rem_to_write -$chars_to_write + set s [string range $s $chars_to_write end] + + # update cur_col + incr cur_col $chars_to_write + # update cur_row + if {$newline} { + term_down + } + + ################## + # write full lines + ################## + while {$chars_rem_to_write >= $cols} { + term_replace $cur_row 0 [string range $s 0 [expr $cols-1]] + + # discard line from buffer + set s [string range $s $cols end] + incr chars_rem_to_write -$cols + + set cur_col 0 + term_down + } + + ################# + # write last line + ################# + + if {$chars_rem_to_write} { + term_replace $cur_row 0 $s + set cur_col $chars_rem_to_write + } + + term_chars_changed +} + +term_init + +expect_before { + -i $term_spawn_id + -re "^\[^\x01-\x1f]+" { + # Text + term_insert $expect_out(0,string) + term_cursor_changed + } "^\r" { + # (cr,) Go to to beginning of line + set cur_col 0 + term_cursor_changed + } "^\n" { + # (ind,do) Move cursor down one line + term_down + term_cursor_changed + } "^\b" { + # Backspace nondestructively + incr cur_col -1 + term_cursor_changed + } "^\a" { + # Bell, pass back to user + send_user "\a" + } "^\t" { + # Tab, shouldn't happen + send_error "got a tab!?" + } eof { + term_exit + } "^\x1b\\\[A" { + # (cuu1,up) Move cursor up one line + incr cur_row -1 + term_cursor_changed + } "^\x1b\\\[C" { + # (cuf1,nd) Nondestructive space + incr cur_col + term_cursor_changed + } -re "^\x1b\\\[(\[0-9]*);(\[0-9]*)H" { + # (cup,cm) Move to row y col x + set cur_row [expr $expect_out(1,string)+1] + set cur_col $expect_out(2,string) + term_cursor_changed + } "^\x1b\\\[H\x1b\\\[J" { + # (clear,cl) Clear screen + term_init + term_cursor_changed + } "^\x1b\\\[7m" { # unsupported + # (smso,so) Begin standout mode + # set term_standout 1 + } "^\x1b\\\[m" { # unsupported + # (rmso,se) End standout mode + # set term_standout 0 + } +} + + +proc term_expect {args} { + global cur_row cur_col # used by expect_background actions + + set desired_timeout [ + uplevel { + if {[info exists timeout]} { + set timeout + } else { + uplevel #0 { + if {[info exists timeout]} { + set timeout + } else { + expr 10 + } + } + } + } + ] + + set timeout $desired_timeout + + set timeout_act {} + + set argc [llength $args] + if {$argc%2 == 1} { + lappend args {} + incr argc + } + + for {set i 0} {$i<$argc} {incr i 2} { + set act_index [expr $i+1] + if {[string compare timeout [lindex $args $i]] == 0} { + set timeout_act [lindex $args $act_index] + set args [lreplace $args $i $act_index] + incr argc -2 + break + } + } + + set got_timeout 0 + + set start_time [timestamp] + + while {![info exists act]} { + expect timeout {set got_timeout 1} + set timeout [expr $desired_timeout - [timestamp] + $start_time] + if {! $got_timeout} \ + { + for {set i 0} {$i<$argc} {incr i 2} { + if {[uplevel [lindex $args $i]]} { + set act [lindex $args [incr i]] + break + } + } + } else { set act $timeout_act } + + if {![info exists act]} { + + } + } + + set code [catch {uplevel $act} string] + if {$code > 4} {return -code $code $string} + if {$code == 4} {return -code continue} + if {$code == 3} {return -code break} + if {$code == 2} {return -code return} + if {$code == 1} {return -code error -errorinfo $errorInfo \ + -errorcode $errorCode $string} + return $string +} + + +# ======= end of terminal emulator ======== + +# The following is a program to interact with the Cornell Library catalog + + +proc waitfornext {} { + global cur_row cur_col term + term_expect {expr {$cur_col==15 && $cur_row == 24 && + " NEXT COMMAND: " == [$term get 24.0 24.16]}} {} +} + +proc sendcommand {command} { + global cur_col + exp_send $command + term_expect {expr {$cur_col == 79}} {} +} + +proc removespaces {intext} { + regsub -all " *\n" $intext \n intext + regsub "\n+$" $intext \n intext + return $intext +} + +proc output {text} { + exp_send_user $text +} + + + +proc connect {} { + global term + term_expect {regexp {.*[>%]} [$term get 1.0 3.end]} + exp_send "tn3270 notis.library.cornell.edu\r" + term_expect {regexp "desk" [$term get 19.0 19.end]} { + exp_send "\r" + } + waitfornext + exp_send_error "connected.\n\n" +} + + +proc dosearch {search} { + global term + exp_send_error "Searching for '$search'..." + 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 + exp_send_error "one entry found.\n\n" + return 1 + } + if {$number == 0} { + exp_send_error "no matches.\n\n" + return 0 + } + exp_send_error "$number entries found.\n" + if {$number > 250} { + exp_send_error "(only the first 250 can be displayed)\n" + } + exp_send_error "\n" + return $number +} + + +proc getshort {count} { + global term + output [removespaces [$term get 5.0 19.0]] + while {[regexp "CONTINUED on next page" [$term get 19.0 19.end]]} { + sendcommand "for\r" + waitfornext + output [removespaces [$term get 5.0 19.0]] + } +} + +proc getonecitation {} { + global term + output [removespaces [$term get 4.0 19.0]] + while {[regexp "FORward page" [$term get 20.0 20.end]]} { + sendcommand "for\r" + waitfornext + output [removespaces [$term get 5.0 19.0]] + } +} + + +proc getcitlist {} { + global term + getonecitation + set citcount 1 + while {[regexp "NEXt record" [$term get 20.0 21.end]]} { + sendcommand "nex\r" + waitfornext + getonecitation + incr citcount + if {$citcount % 10 == 0} {exp_send_error "$citcount.."} + } +} + +proc getlong {count} { + if {$count != 1} { + sendcommand "1\r" + waitfornext + } + sendcommand "lon\r" + waitfornext + getcitlist +} + +proc getmed {count} { + if {$count != 1} { + sendcommand "1\r" + waitfornext + } + sendcommand "bri\r" + waitfornext + getcitlist +} + +################################################################# +# +set help { +libsearch version 1.0 by Adrian Mariano (adrian@cam.cornell.edu) + +Invocation: libsearch [options] search text + + -i : interactive + -s : short listing + -l : long listing + -o file : output file (default stdout) + -h : print out list of options and version number + -H : print terse keyword search help + +The search will be a keyword search. +Example: libsearch -i sound and arabic + +} + +################################################################# + +proc searchhelp {} { + send_error { +? truncation wildcard default operator is AND + +AND - both words appear in record +OR - one of the words appears +NOT - first word appears, second words does not +ADJ - words are adjacent +SAME- words appear in the same field (any order) + +.su. - subject b.fmt. - books eng.lng. - English +.ti. - title m.fmt. - music spa.lng. - Spanish +.au. - author s.fmt. - serials fre.lng. - French + +.dt. or .dt1. -- limits to a specific publication year. E.g., 1990.dt. + +} +} + +proc promptuser {prompt} { + exp_send_error "$prompt" + expect_user -re "(.*)\n" + return "$expect_out(1,string)" +} + + +set searchtype 1 +set outfile "" +set search "" +set interactive 0 + +while {[llength $argv]>0} { + set flag [lindex $argv 0] + switch -glob -- $flag \ + "-i" { set interactive 1; set argv [lrange $argv 1 end]} \ + "-s" { set searchtype 0; set argv [lrange $argv 1 end] } \ + "-l" { set searchtype 2; set argv [lrange $argv 1 end] } \ + "-o" { set outfile [lindex $argv 1]; set argv [lrange $argv 2 end] } \ + "-H" { searchhelp; exit } \ + "-h" { send_error "$help"; exit } \ + "-*" { send_error "\nUnknown option: $flag\n$help";exit }\ + default { set search [join $argv]; set argv {};} +} +if { "$search" == "" } { + send_error "No search specified\n$help" + exit +} + +exp_send_error "Connecting to the library..." + +set timeout 200 + +trap { log_user 1;exp_send "\003"; + expect_before + expect tn3270 {exp_send "quit\r"} + expect "Connection closed." {exp_send "exit\r"} + expect eof ; send_error "\n"; + exit} SIGINT + + +connect + +set result [dosearch $search] + +if {$interactive} { + set quit 0 + while {!$quit} { + if {!$result} { + switch "[promptuser {(h)elp (n)ewsearch (q)uit? }]" { + n { } + h { searchhelp } + q { set quit 1} + } + } else { + switch "[promptuser {(s)hort (m)ed (l)ong (h)elp (n)ewsearch (q)uit? }]" { + s { getshort $result; ;} + l { getlong $result; ;} + m { getmed $result; ; } + n { research; } + h { searchhelp } + q { set quit 1; } + } + } + } +} else { + if {$result} { + switch $searchtype { + 0 { getshort $result} + 1 { getmed $result } + 2 { getlong $result } + } + } +} + + + + + + diff --git a/example/vrfy b/example/vrfy new file mode 100755 index 0000000..49c1b18 --- /dev/null +++ b/example/vrfy @@ -0,0 +1,27 @@ +#!/depot/path/expect -f + + +# separate address into user and host +regexp (.*)@(.*) $argv ignore user host + +log_user 0 +set timeout -1 + +# host might be an mx record, convert to a real host via nslookup +spawn nslookup +expect "> " +send "set query=mx\r" +expect "> " +send "$host\r" +expect { + "No mail exchanger" {} + -re "mail exchanger = (\[^\r]*)" { + set host $expect_out(1,string) + } +} + +spawn telnet $host smtp +expect "220*\r\n" +send "vrfy $user\r" +expect "250" {send_user "GOOD\n"} \ + "550" {send_user "BAD\n"} diff --git a/example/weather b/example/weather new file mode 100755 index 0000000..4bd0e1b --- /dev/null +++ b/example/weather @@ -0,0 +1,81 @@ +#!/bin/sh +# -*- tcl -*- +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh "$0" ${1+"$@"} + +package require Expect + + +# weather - Expect script to get the weather (courtesy University of Michigan) +# Don Libes +# Version 1.10 + +# local weather is retrieved if no argument +# argument is the National Weather Service designation for an area +# I.e., WBC = Washington DC (oh yeah, that's obvious) + +# Notes from Larry Virden <lvirden@yahoo.com> about the new host, +# rainmaker.wunderground.com: "[the] new site requires the +# machine doing the request be located in reverse dns lookup +# or it refuses to provide data." This appears to be a blind error +# condition on the part of rainmaker. + +exp_version -exit 5.0 + +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 +} + +set timeout 60 + +set env(TERM) vt100 ;# actual value doesn't matter, just has to be set + +spawn telnet rainmaker.wunderground.com 3000 +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 + send "\r" + } "Press Return for menu*" { + # this prompt used sometimes, eg, upon opening connection + send "\r" + } "M to display main menu*" { + # sometimes ask this if there is a weather watch in effect + send "M\r" + } "Change scrolling to screen*Selection:" { + break + } eof { + send_user "failed to telnet to weather server\n" + exit + } +} +send "C\r" +expect timeout timedout "Selection:" +send "4\r" +expect timeout timedout "Selection:" +send "1\r" +expect timeout timedout "Selection:" +send "1\r" +expect timeout timedout "city code:" +send "$code\r" +expect $code ;# discard this + +while {1} { + expect timeout { + timedout + } "Press Return to continue*:*" { + send "\r" + } "Press Return to display statement, M for menu:*" { + send "\r" + } -re "(.*)CITY FORECAST MENU.*Selection:" { + break + } +} + +send "X\r" +expect diff --git a/example/xkibitz b/example/xkibitz new file mode 100755 index 0000000..b61a22f --- /dev/null +++ b/example/xkibitz @@ -0,0 +1,219 @@ +#!/bin/sh +# -*- tcl -*- +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh "$0" ${1+"$@"} + +package require Expect + + +# share an xterm with other users +# See xkibitz(1) man page for complete info. +# Compare with kibitz. +# Author: Don Libes, NIST +# Version: 1.2 + +proc help {} { + puts "Commands Meaning" + puts "-------- -------" + puts "return return to program" + puts "= list" + puts "+ <display> add" + puts "- <tag> drop" + puts "where <display> is an X display name such as nist.gov or nist.gov:0.0" + puts "and <tag> 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> " +} + +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 +} + +set tag2pid(0) [pid] +set pid2tty([pid]) "/dev/tty" +if {[info exists env(DISPLAY)]} { + set pid2display([pid]) $env(DISPLAY) +} else { + 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 +} + +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] + } +} + +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 + } +} + +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) + } +} 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) +} +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 -eof exit + } -output $prog + -input ids -output $prog + -input $prog eof exit -output $user_spawn_id -output ids +} + diff --git a/example/xkibitz.man b/example/xkibitz.man new file mode 100644 index 0000000..c1d7fcc --- /dev/null +++ b/example/xkibitz.man @@ -0,0 +1,170 @@ +.TH XKIBITZ 1 "06 October 1994" +.SH NAME +xkibitz \- allow multiple people to interact in an xterm +.SH SYNOPSIS +.B xkibitz +[ +.I xkibitz-args +] [ +.I program program-args... +] +.br +.SH INTRODUCTION +.B xkibitz +allows users in separate xterms to share one shell (or any program +that runs in an xterm). Uses include: +.RS +.TP 4 +\(bu +A novice user can ask an expert user for help. Using +.BR xkibitz , +the expert can see what the user is doing, and offer advice or +show how to do it right. +.TP +\(bu +By running +.B xkibitz +and then starting a full-screen editor, people may carry out a +conversation, retaining the ability to scroll backwards, +save the entire conversation, or even edit it while in progress. +.TP +\(bu +People can team up on games, document editing, or other cooperative +tasks where each person has strengths and weaknesses that complement one +another. +.TP +\(bu +If you want to have a large number of people do an on-line code +walk-through, you can sit two in front of each workstation, and then +connect them all together while you everyone looks at code together +in the editor. +.SH USAGE +To start +.BR xkibitz , +one user (the master) runs xkibitz with no arguments. + +.B xkibitz +starts a new shell (or another program, if given on the command +line). The user can interact normally with the shell, or +upon entering an escape (described when xkibitz starts) can add +users to the interaction. + +To add users, enter "+ display" where display is the X display name. +If there is no ":X.Y" in the display name, ":0.0" is assumed. +The master user must have permission to access each display. +Each display is assigned +a tag \- a small integer which can be used to reference the display. + +To show the current tags and displays, enter "=". + +To drop a display, enter "- tag" where tag is the display's tag +according to the "=" command. + +To return to the shared shell, enter "return". Then the keystrokes of +all users become the input of the shell. Similarly, all users receive +the output from the shell. + +To terminate +.B xkibitz +it suffices to terminate the shell itself. For example, if any user +types ^D (and the shell accepts this to be EOF), the shell terminates +followed by +.BR xkibitz . + +Normally, all characters are passed uninterpreted. However, in the +escape dialogue the user talks directly to the +.B xkibitz +interpreter. Any +.BR Expect (1) +or +.BR Tcl (3) +commands may also be given. +Also, job control may be used while in the interpreter, to, for example, +suspend or restart +.BR xkibitz . + +Various processes +can produce various effects. For example, you can emulate a multi-way write(1) +session with the command: + + xkibitz sleep 1000000 +.PP +.SH ARGUMENTS +.B xkibitz +understands a few special arguments +which should appear before the +.I program +name (if given). +Each argument should be separated by whitespace. +If the arguments themselves takes arguments, +these should also be separated by whitespace. + +.B \-escape +sets the escape character. The default escape character is ^]. + +.B \-display +adds a display much like the "+" command. Multiple \-display flags +can be given. For example, to start up xkibitz with three additional +displays: + + xkibitz -display mercury -display fox -display dragon:1.0 + +.SH CAVEATS +Due to limitations in both X and UNIX, resize propagation is weak. + +When the master user resizes the xterm, all the other xterms are logically +resized. +Unfortunately, xkibitz cannot force the physical xterm size to correspond +with the logical xterm sizes. + +The other users are free to resize their xterm but their sizes are not +propagated. The master can check the logical sizes with the "=" command. + +Deducing the window size is a non-portable operation. The code is known +to work for recent versions of SunOS, AIX, Unicos, and HPUX. Send back +mods if you add support for anything else. +.SH ENVIRONMENT +The environment variable SHELL is used to determine and start a shell, if no +other program is given on the command line. + +If the environment variable DISPLAY is defined, its value is used for the +display name of the +.B xkibitz +master (the display with tag number 0). Otherwise this name remains empty. + +Additional arguments may be passed to new xterms through +the environment variable XKIBITZ_XTERM_ARGS. +For example, to create xterms +with a scrollbar and a green pointer cursor: +.nf + + XKIBITZ_XTERM_ARGS="-sb -ms green" + export XKIBITZ_XTERM_ARGS + +.fi +(this is for the Bourne shell - use whatever syntax is appropriate for your +favorite shell). Any option can be given that is valid for the +.B xterm +command, with the exception of +.BR -display , +.B -geometry +and +.BI -S +as those are set by +.BR xkibitz . +.SH SEE ALSO +.BR Tcl (3), +.BR libexpect (3) +.BR kibitz (1) +.br +.I +"Exploring Expect: A Tcl-Based Toolkit for Automating Interactive Programs" +\fRby Don Libes, +O'Reilly and Associates, January 1995. +.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. +.SH AUTHOR +Don Libes, National Institute of Standards and Technology diff --git a/example/xpstat b/example/xpstat new file mode 100755 index 0000000..ebbfbcf --- /dev/null +++ b/example/xpstat @@ -0,0 +1,274 @@ +#!/bin/sh +# -*- tcl -*- +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh "$0" ${1+"$@"} + +package require Expect + + +# This script acts as a front-end for xpilot. Run it in the background, +# and it will pop up a window for each server it finds running. After +# you run it, press the "?" button for more info. + +# Store the filename of your xpilot client in the following variable. +set xpilot /usr/local/bin/xpilot + +# Author: Don Libes, NIST, 12/29/92 + +# I never have figured out how to get the alias out of xrdb. For now, just +# read it ourselves out of .Xdefaults - ugh. + +log_user 0 + +set timeout 60 + +proc probe {} { + global max db hosts world + + set timeout -1 + + expect_before eof {wait;return 0} + + expect -re "Server on (.*). Enter command> " { + exp_send "S\r" + set host $expect_out(1,string) + # replace dots in hostnames by underscores + regsub -all . $host _ host + # force lowercase to avoid Tk widget name problems + set host [string tolower $host] + lappend hosts $host + } + expect -re "WORLD\[^:]*: (\[^\r]*)\r" { + set worldtmp $expect_out(1,string) + } + expect -re "AUTHOR\[^:]*: (\[^\r]*)\r" { + set author $expect_out(1,string) + } + set world($host) "$worldtmp by $author" + + # skip over junk to get players + expect { + -re -+ {} + -re "Enter command> " { + set max($host) 0 + display $host + return 1 + } + } + set i 0 + expect { + -re "\\.\\.\\. . (................) (...) *(\[^ ]*) *(\[^\r]*)\r" { + # strip trailing blanks + set alias [string trimright $expect_out(1,string)] + set db($host,$i,alias) $alias + + # strip leading zeros + scan $expect_out(2,string) %d db($host,$i,life) + + set db($host,$i,score) $expect_out(3,string) + + set db($host,name,$alias) $expect_out(4,string) + + incr i + exp_continue + } + -re "Enter command>" + + } + set max($host) $i + display $host + + return 1 +} + +proc resize {w a b} { + # 27 is a guess at a fixed-width sufficiently comfortable for + # the variable-width font. I don't know how to do better. + $w configure -width 27 +} + +proc play {host} { + global xpilot alias + + exec xhost $host + catch {exec $xpilot -name $alias($host) -join $host} status +} + +proc show-help {x y msg} { + catch {destroy .help} + toplevel .help + wm geometry .help +$x+$y + + message .help.text -text $msg + + button .help.ok -text "ok" -command {destroy .help} + pack .help.text + pack .help.ok -fill x +} + +# pop up window with alias +proc show-alias {host seln x y} { + global db + + catch {destroy .alias} + toplevel .alias + wm geometry .alias +$x+$y + wm transient .alias . + + regexp "(.*\[^ ]) +\[-0-9]+ +\[0-9]+$" $seln discard alias + + button .alias.b -text "$db($host,name,$alias)" -command { + destroy .alias + } + .alias.b config -padx 1 -pady 1 -highlightthickness 0 + pack .alias.b +} + +proc help {x y} { + show-help $x $y "xpstat - written by Don Libes, NIST, December 29, 1992 + +This script acts as a front-end for xpilot. Run it in the background, and it will pop up a window for each server it finds running. Press the \"?\" button for this info. + +This program polls each xpilot server once a minute. To make it poll immediately, press \"update\". Press \"play as\" to enter the current game with the alias to the right. Edit to taste. (Your alias is initialized from the value of xpilot.name in ~/.Xdefaults.) + +Double-click the left button on an alias to see the real user name. To remove the user name window, click on it with the left button. + +Pan the world/author text, player list, or your own alias by holding the middle mouse button down and moving the mouse." +} + +# if user presses "update" try to update screen immediately +proc prod {x y} { + global cat_spawn_id 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" +} + +proc display {host} { + global world db alias max env + + set w .$host + if {![winfo exists $w]} { + + # window does not exist, create it + + toplevel $w -class xpstat + wm minsize $w 1 1 + wm title $w "xpilot@$host" + wm iconname $w "$host xpilot stats" + entry $w.world -state disabled -textvar world($host) + + listbox $w.players -yscroll "resize $w.players" -font 7x13bold + $w.players config -highlightthickness 0 -border 0 + $w.world config -highlightthickness 0 + + bind $w.players <Double-Button-1> { + scan %W ".%%\[^.]" host + show-alias $host [selection get] %X %Y + } + + message $w.msg -text "no players" -aspect 1000 -justify center + + button $w.help -text ? -command { + help 10 20 + } + + button $w.update -text "update" + bind $w.update <1> { + after 1 prod %X %Y + } + + button $w.play -text "play as" + bind $w.play <1> { + scan %W ".%%\[^.]" host + after 1 play $host + } + + entry $w.alias -textvar alias($host) -width 10 + set alias($host) $env(USER) + + bind $w.alias <Return> { + scan %W ".%%\[^.]" host + play $host + } + + $w.play config -padx 1 -pady 1 -highlightthickness 0 + $w.update config -padx 1 -pady 1 -highlightthickness 0 + $w.help config -padx 1 -pady 1 -highlightthickness 0 + $w.alias config -highlightthickness 0 + + pack $w.world -expand 1 -fill x + pack $w.msg + 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} { + # put up "no players" message? + 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} { + pack $w.players -after $w.world -side top + pack forget $w.msg + } + } + + $w.players delete 0 end + + for {set i 0} {$i<$max($host)} {incr i} { + $w.players insert end [format "%-17s %4d %d" \ + $db($host,$i,alias) \ + $db($host,$i,score) \ + $db($host,$i,life) \ + ] + } + + set max($host,was) $max($host) +} + +wm withdraw . +set oldhosts {} + +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} { + regexp "xpilot.name:\[ \t]*(\[^\r]*)" $output dummy env(USER) +} + +spawn cat -u; set cat_spawn_id $spawn_id + +while {1} { + global xpilot hosts + + set hosts {} + + eval spawn $xpilot $argv + while {[probe]} {exp_send "N\r"} + catch {expect_before} ;# disable expect_before from inside probe + + # clean up hosts that no longer are running xpilots + + foreach host $oldhosts { + # if host not in hosts + if {-1==[lsearch $hosts $host]} { + destroy .$host + } + } + set oldhosts $hosts + + set updateflag 0 + + # sleep for a little while, subject to click from "update" button + expect -i $cat_spawn_id -re "...." ;# two crlfs +} diff --git a/example/xrlogin b/example/xrlogin new file mode 100644 index 0000000..172da2f --- /dev/null +++ b/example/xrlogin @@ -0,0 +1,22 @@ +#!/depot/path/expect -- +# xrlogin - rlogin but with current DISPLAY +# +# You can extend this idea to save any arbitrary information across rlogin +# Don Libes - Oct 17, 1991. + +if {[llength $argv] != 1} { + puts "usage: xrlogin remotehost" + exit +} + +set prompt "(%|#|\\$) $" ;# default prompt +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)]} { + set env(DISPLAY) "[exec hostname].[exec domainname]:0.0\r" +} +send "setenv DISPLAY $env(DISPLAY)\r" +interact |