OpenCores

/dislocate.man

0,0 → 1,100

dislocate.man Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: ftp-inband =================================================================== --- ftp-inband (nonexistent) +++ ftp-inband (revision 1765) @@ -0,0 +1,295 @@ +#!../expect -f +# 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 +

ftp-inband Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: xrlogin =================================================================== --- xrlogin (nonexistent) +++ xrlogin (revision 1765) @@ -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

xrlogin Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: telnet-in-bg =================================================================== --- telnet-in-bg (nonexistent) +++ telnet-in-bg (revision 1765) @@ -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 +} +

telnet-in-bg Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: dvorak =================================================================== --- dvorak (nonexistent) +++ dvorak (revision 1765) @@ -0,0 +1,29 @@ +#!../expect -f +# 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

dvorak Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: vrfy =================================================================== --- vrfy (nonexistent) +++ vrfy (revision 1765) @@ -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"}

vrfy Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: mkpasswd =================================================================== --- mkpasswd (nonexistent) +++ mkpasswd (revision 1765) @@ -0,0 +1,203 @@ +#!/depot/path/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 verbose 0 +set distribute 0 + +if [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] + } "-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 " -v (verbose, show passwd interaction)" + puts " -p prog (program to set password, default = $defaultprog)" + exit 1 +} + +if {$minnum + $minlower + $minupper > $length} { + puts "impossible to generate $length-character password\ + with $minnum numbers, $minlower lowercase letters,\ + and $minupper uppercase letters" + exit 1 +} + +# 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 + +# 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] +} + +set _ran [pid] + +proc rand {m} { + global _ran + + set period 259200 + set _ran [expr ($_ran*7141 + 54773) % $period] + expr int($m*($_ran/double($period))) +} + +# 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} +} 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] + +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 + } +} + +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"

mkpasswd Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: passmass =================================================================== --- passmass (nonexistent) +++ passmass (revision 1765) @@ -0,0 +1,189 @@ +#!../expect -- +# passmass: change password on many machines +# Synopsis: passmass host1 host2 host3 .... +# Don Libes - March 11, 1991 + +# Description: Change passwords on the named machines. +# +# You are prompted for old/new passwords. (If you are changing root +# passwords and have equivalencing, the old password is not used and may be +# omitted.) +# +# Additional arguments may be used for fine tuning. They affect all hosts +# which follow until another argument overrides. +# +# -user User whose password will be changed. By default, the current +# user is used. +# -rlogin Use rlogin to access host. (default) +# -telnet Use telnet to access host. +# -program Next argument is taken as program to run to set password. +# Default is "passwd". Other common choices are "yppasswd" and +# "set passwd" (e.g., VMS hosts). +# -prompt Next argument is taken as a prompt suffix pattern. This allows +# the script to know when the shell is prompting. The default is +# "# " for root and "% " for non-root accounts. +# -timeout Next argument is number of seconds to wait for responses. +# Default is 30 but some systems can be much slower logging in. + +# The best way to run this is to put the command in a one-line shell script +# or alias. (Presumably, the set of hosts and parameters will rarely change.) +# Then run it whenever you want to change your passwords on all the hosts. + +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 timeout 1000000 +stty -echo +send_user "old password: " +expect_user -re "(.*)\n" +send_user "\n" +set oldpassword $expect_out(1,string) +send_user "new password: " +expect_user -re "(.*)\n" +send_user "\n" +set newpassword $expect_out(1,string) +send_user "retype new password: " +expect_user -re "(.*)\n" +set newpassword2 $expect_out(1,string) +send_user "\n" +stty echo +trap exit SIGINT + +if ![string match $newpassword $newpassword2] { + send_user "mismatch - password unchanged\n" + exit +} + + +#send_user "want to see new password you just typed? (y|n) " +#expect_user "*\n" +# +#if [string match "y" [lindex $expect_match 0 c]] { +# send_user "password is <$newpassword>\nproceed? (y|n) " +# expect_user "*\n" +# if ![string match "y" [lindex $expect_match 0 c]] exit +#} + +set timeout 30 +set badhosts {} +for {set i 0} {$i<$argc} {incr i} { + + set arg [lindex $argv $i] + switch -- $arg \ + "-user" { + incr i + set user [lindex $argv $i] + continue + } "-prompt" { + incr i + set prompt [lindex $argv $i] + continue + } "-rlogin" { + set login "rlogin" + continue + } "-telnet" { + set login "telnet" + continue + } "-program" { + incr i + set program [lindex $argv $i] + continue + } "-timeout" { + incr i + set timeout [lindex $argv $i] + continue + } + + set host $arg + if [string match $login "rlogin"] { + set pid [spawn rlogin $host -l $user] + } else { + set pid [spawn telnet $host] + expect -re "(login|Username):.*" { + send "$user\r" + } + } + + if ![info exists prompt] { + if [string match $user "root"] { + set prompt "# " + } else { + set prompt "(%|\\\$) " + } + } + + set logged_in 0 + for {} 1 {} { + expect "Password*" { + send "$oldpassword\r" + } eof { + badhost $host "spawn failed" + break + } timeout { + badhost $host "could not log in (or unrecognized prompt)" + exec kill $pid + expect eof + break + } -re "incorrect|invalid" { + badhost $host "bad password or login" + exec kill $pid + expect eof + break + } -re $prompt { + set logged_in 1 + break + } + } + + if (!$logged_in) { + wait + continue + } + + send "$program\r" + expect "Old password*" { + send "$oldpassword\r" + expect "Sorry*" { + badhost $host "old password is bad?" + continue + } "password:" + } -re "(n|N)ew password:" + send "$newpassword\r" + expect -re "not changed|unchanged" { + badhost $host "new password is bad?" + continue + } -re "(password|Verification|Verify|again):.*" + send "$newpassword\r" + expect -re "(not changed|incorrect|choose new).*" { + badhost $host "password is bad?" + continue + } -re "$prompt" + send_user "\n" + + close + wait +} + +if [llength $badhosts] {send_user "\nfailed to set password on $badhosts\n"}

passmass Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: read1char =================================================================== --- read1char (nonexistent) +++ read1char (revision 1765) @@ -0,0 +1,8 @@ +#!../expect -- + +# read a single character +# Author: Don Libes, NIST + +stty raw +expect ? +send_user $expect_out(buffer)

read1char Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: archie =================================================================== --- archie (nonexistent) +++ archie (revision 1765) @@ -0,0 +1,36 @@ +#!../expect -f + +# 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} +}

archie Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: rlogin-display =================================================================== --- rlogin-display (nonexistent) +++ rlogin-display (revision 1765) @@ -0,0 +1,18 @@ +#!/depot/path/expect -- +# rlogin.exp - rlogin but with current DISPLAY +# +# 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 +if [string match "unix:0.0" $env(DISPLAY)] { + send "setenv DISPLAY [exec hostname].[exec domainname]:0.0\r" +} else { + send "setenv DISPLAY $env(DISPLAY)\r" +} +interact

rlogin-display Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: cryptdir =================================================================== --- cryptdir (nonexistent) +++ cryptdir (revision 1765) @@ -0,0 +1,63 @@ +#!../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 files with mistyped password! +if !$decrypt { + send "Again:" + expect -re "(.*)\n" + send "\n" + if ![string match $passwd $expect_out(1,string)] { + send_user "mistyped password?\n" + stty echo + exit + } +} +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"

cryptdir Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: ftp-rfc =================================================================== --- ftp-rfc (nonexistent) +++ ftp-rfc (revision 1765) @@ -0,0 +1,34 @@ +#!../expect -- + +# ftp-rfc +# 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 +

ftp-rfc Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: passwd.cgi =================================================================== --- passwd.cgi (nonexistent) +++ passwd.cgi (revision 1765) @@ -0,0 +1,105 @@ +#!/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 " + +Passwd Change Acknowledgment + + +

Passwd Change Acknowledgment

+" + +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 "

Error: $s

"} +proc successmsg {s} {puts "

$s

"} + +# 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) +} + +if [info exists error] { + errormsg "$error" +} else { + successmsg "Password changed successfully." +} +

passwd.cgi Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: tknewsbiff =================================================================== --- tknewsbiff (nonexistent) +++ tknewsbiff (revision 1765) @@ -0,0 +1,515 @@ +#!../expectk -f + +# 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 { + 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 +}

tknewsbiff Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: mkpasswd.man =================================================================== --- mkpasswd.man (nonexistent) +++ mkpasswd.man (revision 1765) @@ -0,0 +1,95 @@ +.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 \-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. + +

mkpasswd.man Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: gethostbyaddr =================================================================== --- gethostbyaddr (nonexistent) +++ gethostbyaddr (revision 1765) @@ -0,0 +1,326 @@ +#!../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]}

gethostbyaddr Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: chesslib++.c =================================================================== --- chesslib++.c (nonexistent) +++ chesslib++.c (revision 1765) @@ -0,0 +1,84 @@ +/* testlib.c for c++ - test expectlib */ + +#include +#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; + + fd1 = exp_spawnl("chess","chess",(char *)0); + + 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); + } +}

chesslib++.c Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: passmass.man =================================================================== --- passmass.man (nonexistent) +++ passmass.man (revision 1765) @@ -0,0 +1,88 @@ +.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 +-telnet +Use telnet to access host. + +.TP 4 +-program +Next argument is taken as program to run to set password. +Default is "passwd". Other common choices are "yppasswd" and +"set passwd" (e.g., VMS hosts). + +.TP 4 +-prompt +Next argument is taken as a prompt suffix pattern. This allows +the script to know when the shell is prompting. The default is +"# " for root and "% " for non-root accounts. + +.TP 4 +-timeout +Next argument is number of seconds to wait for responses. +Default is 30 but some systems can be much slower logging in. + +.SH HOW TO USE +The best way to run Passmass is to put the command in a one-line shell +script or alias. Whenever you get a new account on a new machine, add +the appropriate arguments to the command. Then run it whenever you +want to change your passwords on all the hosts. + +.SH CAVEATS + +It should be obvious that using the same password on multiple hosts +carries risks. In particular, if the password can be stolen, then all +of your accounts are at risk. Thus, you should not use Passmass in +situations where your password is visible, such as across a network +where hackers are known to eavesdrop. + +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

passmass.man Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: passwd.html =================================================================== --- passwd.html (nonexistent) +++ passwd.html (revision 1765) @@ -0,0 +1,25 @@ + + +Change your login password + + + +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 +

+ + + +

passwd.html Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: timed-run =================================================================== --- timed-run (nonexistent) +++ timed-run (revision 1765) @@ -0,0 +1,7 @@ +#!../expect -f +# 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

timed-run Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: telnet-cwd =================================================================== --- telnet-cwd (nonexistent) +++ telnet-cwd (revision 1765) @@ -0,0 +1,13 @@ +#!../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

telnet-cwd Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: tkterm =================================================================== --- tkterm (nonexistent) +++ tkterm (revision 1765) @@ -0,0 +1,409 @@ +#!../expectk -f + +# Name: tkterm - terminal emulator using Expect and Tk text widget, v1.0 +# Author: Don Libes, July '94 + +# 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 +# Good-enough-for-starters attributes: +# Understands one kind of standout mode (reverse video) +# Should-be-fixed-soon attributes: +# Does not support scrollbar or 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 cols 80 ;# number of columns in term +set term .t ;# name of text widget used by term +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 +############################################# + + +unset env(DISPLAY) +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: + :nd=\E[C: + :cl=\E[H\E[J: + :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 { + 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, + 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) "/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 -relief sunken -bd 1 -width $cols -height $rows -wrap none + +if {$term_alone} { + pack $term +} + +$term tag configure standout -background black -foreground white + +proc term_clear {} { + global term + + $term delete 1.0 end + term_init +} + +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 +} + +proc term_down {} { + global cur_row rows cols term + + if {$cur_row < $rows} { + incr cur_row + } else { + # 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 + } +} + +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 + +set flush 0 +proc screen_flush {} { + global flush + incr flush + if {$flush == 24} { + update idletasks + set flush 0 + } +# update idletasks +# after 1000 a +} + + + +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 + incr cur_row -1 + 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\\\[7m" { + # (smso,so) Begin standout mode + set term_standout 1 + } "^\x1b\\\[m" { + # (rmso,se) End standout mode + set term_standout 0 + } +} + +bind $term { + focus %W +} +bind $term { + if {"%A" != ""} { + exp_send -i $term_spawn_id "\033%A" + } +} + +bind $term { + exp_send -i $term_spawn_id -- %A + break +} + +bind $term {exp_send -null} +bind $term {exp_send -null} + +bind $term {exp_send -i $term_spawn_id "\033OP"} +bind $term {exp_send -i $term_spawn_id "\033OQ"} +bind $term {exp_send -i $term_spawn_id "\033OR"} +bind $term {exp_send -i $term_spawn_id "\033OS"} +bind $term {exp_send -i $term_spawn_id "\033OT"} +bind $term {exp_send -i $term_spawn_id "\033OU"} +bind $term {exp_send -i $term_spawn_id "\033OV"} +bind $term {exp_send -i $term_spawn_id "\033OW"} +bind $term {exp_send -i $term_spawn_id "\033OX"}

tkterm Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: reprompt =================================================================== --- reprompt (nonexistent) +++ reprompt (revision 1765) @@ -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) + } +}

reprompt Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: decryptdir =================================================================== --- decryptdir (nonexistent) +++ decryptdir (revision 1765) @@ -0,0 +1,63 @@ +#!../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 files with mistyped password! +if !$decrypt { + send "Again:" + expect -re "(.*)\n" + send "\n" + if ![string match $passwd $expect_out(1,string)] { + send_user "mistyped password?" + stty echo + exit + } +} +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"

decryptdir Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: cryptdir.man =================================================================== --- cryptdir.man (nonexistent) +++ cryptdir.man (revision 1765) @@ -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

cryptdir.man Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: timed-read =================================================================== --- timed-read (nonexistent) +++ timed-read (revision 1765) @@ -0,0 +1,6 @@ +#!../expect -f +# 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)}

timed-read Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: rogue.exp =================================================================== --- rogue.exp (nonexistent) +++ rogue.exp (revision 1765) @@ -0,0 +1,17 @@ +#!../expect -f +# 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

rogue.exp Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: tknewsbiff.man =================================================================== --- tknewsbiff.man (nonexistent) +++ tknewsbiff.man (revision 1765) @@ -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 { + 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 { + 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

tknewsbiff.man Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: unbuffer =================================================================== --- unbuffer (nonexistent) +++ unbuffer (revision 1765) @@ -0,0 +1,7 @@ +#!../expect -- +# Description: unbuffer stdout of a program +# Author: Don Libes, NIST + +eval spawn -noecho $argv +set timeout -1 +expect

unbuffer Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: chesslib.c =================================================================== --- chesslib.c (nonexistent) +++ chesslib.c (revision 1765) @@ -0,0 +1,80 @@ +/* chesslib.c - test expectlib */ + +#include +#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; + + fd1 = exp_spawnl("chess","chess",(char *)0); + + 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); + } +}

chesslib.c Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: Makefile =================================================================== --- Makefile (nonexistent) +++ Makefile (revision 1765) @@ -0,0 +1,75 @@ +TCLVERSION = 8.0 +EXPVERSION = 5.25 +TCLROOT = ../../tcl$(TCLVERSION) + +# Tcl include files. (If you haven't installed Tcl yet, read the README file). +# This must point to the directory that contains ALL of Tcl's include +# files, not just the public ones. +TCLHDIR = $(TCLROOT)/generic + +# TCL library. Very little actually comes out of it, but it is handy. +TCLLIB = $(TCLROOT)/unix/libtcl$(TCLVERSION).so +# if installed, you can use: +# TCLLIB = -ltcl + +CC = gcc +CPLUSPLUS = g++ +CPLUSPLUSLIBDIR = -L/depot/gnu/arch/lib +CPLUSPLUSLIB = -lg++ + +CFLAGS = -g -I.. -I$(TCLHDIR) +LIBEXPECT = -L.. -lexpect$(EXPVERSION) + +LIBS = $(LIBEXPECT) $(TCLLIB) -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)

Makefile Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: beer.exp.out =================================================================== --- beer.exp.out (nonexistent) +++ beer.exp.out (revision 1765) @@ -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.

beer.exp.out Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: term_expect =================================================================== --- term_expect (nonexistent) +++ term_expect (revision 1765) @@ -0,0 +1,488 @@ +#!/usr/local/bin/expectk -- + +# Name: tkterm - terminal emulator using Expect and Tk text widget, v1.0 +# Author: Don Libes, July '94 + +# 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). + +############################### +# 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 +# Good-enough-for-starters attributes: +# Understands one kind of standout mode (reverse video) +# Should-be-fixed-soon attributes: +# Does not support scrollbar or 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 cols 80 ;# number of columns in term +set term .t ;# name of text widget used by term +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 +############################################# + + +unset env(DISPLAY) +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: + :nd=\E[C: + :cl=\E[H\E[J: + :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 { + 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, + 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) "/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 -relief sunken -bd 1 -width $cols -height $rows -wrap none + +if {$term_alone} { + pack $term +} + +$term tag configure standout -background black -foreground white + +proc term_clear {} { + global term + + $term delete 1.0 end + term_init +} + +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 +} + +proc term_down {} { + global cur_row rows cols term + + if {$cur_row < $rows} { + incr cur_row + } else { + # 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 + } +} + +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 + +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 + 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 + incr cur_row -1 + 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\\\[7m" { + # (smso,so) Begin standout mode + set term_standout 1 + } "^\x1b\\\[m" { + # (rmso,se) End standout mode + set term_standout 0 + } +} + +bind $term { + focus %W +} +bind $term { + if {"%A" != ""} { + exp_send -i $term_spawn_id "\033%A" + } +} +bind $term { + exp_send -i $term_spawn_id -- %A + break +} + +bind $term {exp_send -null} +bind $term {exp_send -null} + +bind $term {exp_send -i $term_spawn_id "\033OP"} +bind $term {exp_send -i $term_spawn_id "\033OQ"} +bind $term {exp_send -i $term_spawn_id "\033OR"} +bind $term {exp_send -i $term_spawn_id "\033OS"} +bind $term {exp_send -i $term_spawn_id "\033OT"} +bind $term {exp_send -i $term_spawn_id "\033OU"} +bind $term {exp_send -i $term_spawn_id "\033OV"} +bind $term {exp_send -i $term_spawn_id "\033OW"} +bind $term {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... +

term_expect Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: autoexpect =================================================================== --- autoexpect (nonexistent) +++ autoexpect (revision 1765) @@ -0,0 +1,347 @@ +#!../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] { + 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) + } null { + input_null + } \ + -o \ + -re .+ { + output $interact_out(0,string) + } eof { + cmd "expect eof" + return + } null { + } +} + +close $fd +verbose_send_user "autoexpect done, file is $filename\n"

autoexpect Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: beer.out =================================================================== --- beer.out (nonexistent) +++ beer.out (revision 1765) @@ -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.

beer.out Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: decryptdir.man =================================================================== --- decryptdir.man (nonexistent) +++ decryptdir.man (revision 1765) @@ -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

decryptdir.man Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: xpstat =================================================================== --- xpstat (nonexistent) +++ xpstat (revision 1765) @@ -0,0 +1,269 @@ +#!../expectk -- + +# 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 0==[llength [info com $w]] + 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 { + 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 { + 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 +}

xpstat Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: xkibitz =================================================================== --- xkibitz (nonexistent) +++ xkibitz (revision 1765) @@ -0,0 +1,208 @@ +#!../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 "+ add" + puts "- drop" + puts "where is an X display name such as nist.gov or nist.gov:0.0" + puts "and is a tag from the = command." + puts "+ and - require whitespace before argument." + puts {return command must be spelled out ("r", "e", "t", ...).} +} + +proc prompt1 {} { + return "xkibitz> " +} + +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 + } +} + +exit -onexit { + unset pid2display([pid]) ;# avoid killing self + + foreach pid [array names pid2display] { + catch {exec kill -9 $pid} + } +} + +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 + } -output $prog + -input ids -output $prog + -input $prog -output $user_spawn_id -output ids +} +

xkibitz Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: unbuffer.man =================================================================== --- unbuffer.man (nonexistent) +++ unbuffer.man (revision 1765) @@ -0,0 +1,41 @@ +.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. +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 +.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

unbuffer.man Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: lpunlock =================================================================== --- lpunlock (nonexistent) +++ lpunlock (revision 1765) @@ -0,0 +1,95 @@ +#!../expect -f + +# 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 \[\]\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

lpunlock Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: virterm =================================================================== --- virterm (nonexistent) +++ virterm (revision 1765) @@ -0,0 +1,634 @@ +#!../expect -- + +# Name: virterm - terminal emulator using Expect, v1.0, December, 1994 +# Author: Adrian Mariano +# +# 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: puts "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 } + } + } +} + + + + + +

virterm Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: autopasswd =================================================================== --- autopasswd (nonexistent) +++ autopasswd (revision 1765) @@ -0,0 +1,11 @@ +#!../expect -f +# 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 "password:" +send "$password\r" +expect "password:" +send "$password\r" +expect eof

autopasswd Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: autoexpect.man =================================================================== --- autoexpect.man (nonexistent) +++ autoexpect.man (revision 1765) @@ -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. +

autoexpect.man Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: kibitz =================================================================== --- kibitz (nonexistent) +++ kibitz (revision 1765) @@ -0,0 +1,406 @@ +#!../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 {} { + global user_number + + # KABORT tells user_number 1 that user_number 3 has run into problems + # and is exiting, and diagnostics have been returned already + if $user_number==3 {send_user KABORT} + exit +} + +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\"" | \ + /bin/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 -output "$user_spawn_id $userout" + } + wait -i $shell + } +} + +if $local_io rmfifos

kibitz Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: README =================================================================== --- README (nonexistent) +++ README (revision 1765) @@ -0,0 +1,141 @@ +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. + 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 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 + 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. +

README Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: expectd.proto =================================================================== --- expectd.proto (nonexistent) +++ expectd.proto (revision 1765) @@ -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}

expectd.proto Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: xkibitz.man =================================================================== --- xkibitz.man (nonexistent) +++ xkibitz.man (revision 1765) @@ -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

xkibitz.man Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: chesslib2.c =================================================================== --- chesslib2.c (nonexistent) +++ chesslib2.c (revision 1765) @@ -0,0 +1,84 @@ +/* testlib.c - test expectlib */ + +#include +#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"))) { + printf("exp_popen failed\n"); + 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); + } +}

chesslib2.c Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: weather =================================================================== --- weather (nonexistent) +++ weather (revision 1765) @@ -0,0 +1,81 @@ +#!../expect -f + +# weather - Expect script to get the weather (courtesy University of Michigan) +# Don Libes +# Version 1.9 + +# 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) + +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 +} + +# delete special weather statement question +proc delete_special {s} { + set x [string first " ******" $s] + return [join [lrange [split $s ""] 0 $x] ""] +} + +set timeout 60 +log_user 0 + +set env(TERM) vt100 ;# actual value doesn't matter, just has to be set + +spawn telnet downwind.sprl.umich.edu 3000 +match_max 100000 +for {} 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 + +for {} 1 {} { + expect timeout { + timedout + } "Press Return to continue*:*" { + send_user "\n[delete_special $expect_out(buffer)]\n" + send "\r" + } "Press Return to display statement, M for menu:*" { + send_user "\n[delete_special $expect_out(buffer)]\n" + send "\r" + } -re "(.*)CITY FORECAST MENU.*Selection:" { + send_user "\n$expect_out(1,string)\n" + break + } +} + +send "X\r" +expect +

weather Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: chess.exp =================================================================== --- chess.exp (nonexistent) +++ chess.exp (revision 1765) @@ -0,0 +1,52 @@ +#!../expect -f +# 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) + +for {} 1 {} { + expect { + -i $id2 -re "\\.\\. (.*)\n" { + send -i $id1 $expect_out(1,string) + } + -i $id1 -re "\\.\\. .*\\. (.*)\n" { + send -i $id2 $expect_out(1,string) + } + } +}

chess.exp Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: robohunt =================================================================== --- robohunt (nonexistent) +++ robohunt (revision 1765) @@ -0,0 +1,80 @@ +#!../expect -f +# 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:" +sleep 1 +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)} +}

robohunt Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: tkpasswd =================================================================== --- tkpasswd (nonexistent) +++ tkpasswd (revision 1765) @@ -0,0 +1,630 @@ +#!/depot/path/expectk -f +# 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} { + global env + + foreach dir [split $env(PATH) :] { + if [file executable $dir/$prog] { + return 1 + } + } + return 0 +} + +frame .type -relief raised -bd 1 + +radiobutton .passwd -text passwd -variable passwd_cmd \ + -value {passwd {cat /etc/passwd}} \ + -anchor w -command get_users -relief flat +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 "*-bold-o-normal-*-120-*-m-*" -setgrid 1 +.names tag configure nopassword -relief raised +.names tag configure selection -relief raised + +set iscolor 0 +if {[winfo depth .] > 1} { + set iscolor 1 +} + +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 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] { + rename set s + foreach w [split [read $file] "\n"] {s dict($w) ""} + close $file + rename s set + set dict_loaded 1 + feedback "dictionary loaded" + } else { + feedback "dictionary missing" + .dict deselect + } +} + +# 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 + } + } +} + +set _ran [pid] +proc rand {m} { + global _ran + + set period 259200 + set _ran [expr ($_ran*7141 + 54773) % $period] + expr int($m*($_ran/double($period))) +} + +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] + +# wm title $w "" +# wm iconname $w "" + + message $w.text -aspect 300 -text \ +"These parameters control generation of random passwords. + +It is not necessary to move the mouse into this window to operate it.\ +Press to move to the next entry.\ +Press or click the button when you are done." + + foreach desc { + {length {total length}} + {minnum {minimum number of digits}} + {minupper {minimum number of uppercase letters}} + {minlower {minimum number of lowercase letters}}} { + set name [lindex $desc 0] + set text [lindex $desc 1] + frame $w.$name -bd 1 + entry $w.$name.entry -relief sunken -width 2 -textvar $name + bind $w.$name.entry "Tab \$parm_tabList" + bind $w.$name.entry "destroy_parm_window" + label $w.$name.text -text $text + pack $w.$name.entry -side left + pack $w.$name.text -side left + lappend parm_tabList $w.$name.entry + } + frame $w.2 -bd 1 + checkbutton $w.2.cb -text "alternate characters across hands" \ + -relief flat -variable distribute + pack $w.2.cb -side left + + button $w.ok -text "ok" -command "destroy_parm_window" + pack $w.text -expand 1 -fill x + pack $w.length $w.minnum $w.minupper $w.minlower $w.2 -expand 1 -fill x + pack $w.ok -side left -fill x -expand 1 -padx 2 -pady 2 + +#strace 10 + set oldfocus [focus] +# $w.length.entry icursor end + tkwait visibility $w.length.entry + focus $w.length.entry +# grab $w + tkwait window $w +# grab release $w + focus $oldfocus + +#strace 0 + + save_parameters +} + +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 {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 + global nopasswords + + if 0==[llength $nopasswords] { + feedback "no null passwords" + return + } + + if $direction==1 { + # is there a better way to get last element of list? + if $selection_line>=[lindex $nopasswords [expr [llength $nopasswords]-1]] { + set selection_line 0 + } + foreach i $nopasswords { + if $selection_line<$i break + } + } else { + if $selection_line<=[lindex $nopasswords 0] { + set selection_line $last_line + } + set j [expr [llength $nopasswords]-1] + for {} {$j>=0} {incr j -1} { + set i [lindex $nopasswords $j] + if $selection_line>$i break + } + } + set selection_line $i + make_selection +} + +proc select {w coords} { + global selection_line + + $w mark set insert "@$coords linestart" + $w mark set anchor insert + set first [$w index "anchor linestart"] + set last [$w index "insert lineend + 1c"] + scan $first %d selection_line + + $w tag remove selection 0.0 end + $w tag add selection $first $last +} + +bind Text <1> {select %W %x,%y} +bind Text {select %W %x,%y} +bind Text {select %W %x,%y} +bind Text <2> {select %W %x,%y} +bind Text <3> {select %W %x,%y} +bind Text {} +bind Text {} +bind Text {} +bind Text {} + +bind .password {incr selection_line 1; make_selection} +bind .password {incr selection_line -1;make_selection} +bind .password {select_next_nopassword 1} +bind .password {select_next_nopassword -1} +bind .password {password_generate} +bind .password {adjust_parameters} +bind .password {set password ""} +bind Entry {exit}

tkpasswd Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: carpal =================================================================== --- carpal (nonexistent) +++ carpal (revision 1765) @@ -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 [timestamp] ;# when we started our current typing period +set stop [timestamp] ;# when we stopped typing + +set typing 1200 ;# twenty minutes, max typing time allowed +set notyping 600 ;# ten minutes, min notyping time required + +interact -nobuffer -re . { + set now [timestamp] + + if {$now-$stop > $notyping} { + set start [timestamp] + } elseif {$now-$start > $typing} { + send_user "\007" + } + set stop [timestamp] +}

carpal Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: irsh =================================================================== --- irsh (nonexistent) +++ irsh (revision 1765) @@ -0,0 +1,11 @@ +#!/depot/path/expect -- + +# Do rsh interactively. For example, consider the following command: +# rsh 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

irsh Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: rlogin-cwd =================================================================== --- rlogin-cwd (nonexistent) +++ rlogin-cwd (revision 1765) @@ -0,0 +1,14 @@ +#!../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

rlogin-cwd Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: kibitz.man =================================================================== --- kibitz.man (nonexistent) +++ kibitz.man (revision 1765) @@ -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.

kibitz.man Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: dislocate =================================================================== --- dislocate (nonexistent) +++ dislocate (revision 1765) @@ -0,0 +1,342 @@ +#!../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} { + global prefix infifosuffix + + return "/tmp/$prefix$pid$infifosuffix" +} + +proc outfifoname {pid} { + global prefix outfifosuffix + + return "/tmp/$prefix$pid$outfifosuffix" +} + +proc pid_remove {pid} { + global date proc + + say "removing $pid $proc($pid)" + + unset date($pid) + unset proc($pid) +} + +# lines in data file looks 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) + +# load pidfile into memory +proc pidfile_read {} { + global date proc pidfile + + if [catch {open $pidfile} fp] return + + # + # read info out of file + # + + say "reading pidfile" + set line 0 + while {[gets $fp buf]!=-1} { + # while pid and date can't have # in it, proc can + if [regexp "(\[^#]*)#(\[^#]*)#(.*)" $buf junk pid xdate xproc] { + set date($pid) $xdate + set proc($pid) $xproc + } else { + puts "warning: inconsistency in $pidfile line $line" + } + incr line + } + close $fp + say "read $line entries" + + # + # see if pids and fifos are still around + # + + foreach pid [array names date] { + if {$pid && [catch {exec /bin/kill -0 $pid}]} { + say "$pid no longer exists, removing" + pid_remove $pid + continue + } + + # pid still there, see if fifos are + if {![file exists [infifoname $pid]] || ![file exists [outfifoname $pid]]} { + say "$pid fifos no longer exists, removing" + pid_remove $pid + continue + } + } +} + +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 + + catch {exec rm -f [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 catflags infifosuffix outfifosuffix + + disconnect + + # these are backwards from the child's point of view so that + # we can make everything else look "right" + set infifosuffix ".o" + set outfifosuffix ".i" + set pid 0 + + eval spawn $argv + set proc_spawn_id $spawn_id + + while {1} { + say "opening [infifoname $pid] for read" + spawn -open [open "|cat $catflags < [infifoname $pid]" "r"] + set in $spawn_id + + say "opening [outfifoname $pid] for write" + spawn -open [open [outfifoname $pid] w] + set out $spawn_id + + fifo_pair_remove $pid + + say "interacting" + interact { + -u $proc_spawn_id eof exit + -output $out + -input $in + } + + # parent has closed connection + say "parent closed connection" + catch {close -i $in} + catch {wait -i $in} + catch {close -i $out} + catch {wait -i $out} + + # switch to using real pid + set pid [pid] + # put entry back + fifo_pair_create $pid $argdate $argv + } +} + +proc say {msg} { + global debug_flag + + if !$debug_flag return + + if [catch {puts "parent: $msg"}] { + send_log "child: $msg\n" + } +} + +proc escape {} { + # export process handles so that user can get at them + global in out + + puts "\nto disconnect, enter: exit (or ^D)" + puts "to suspend, press appropriate job control sequence" + puts "to return to process, enter: return" + interpreter + puts "returning ..." +} + +# interactively query user to choose process, return pid +proc choose {} { + global index date + + while 1 { + send_user "enter # or pid: " + expect_user -re "(.*)\n" {set buf $expect_out(1,string)} + if [info exists index($buf)] { + set pid $index($buf) + } elseif [info exists date($buf)] { + set pid $buf + } else { + puts "no such # or pid" + continue + } + return $pid + } +} + +if {$argc} { + # initial creation occurs before fork because if we do it after + # then either the child or the parent may have to spin retrying + # the fifo open. Unfortunately, we cannot know the pid ahead of + # time so use "0". This will be set to the real pid when the + # parent does its initial disconnect. There is no collision + # problem because the fifos are deleted immediately anyway. + + set datearg [exec date] + fifo_pair_create 0 $datearg $argv + + set pid [fork] + say "after fork, pid = $pid" + if $pid==0 { + child $datearg $argv + } + # parent thinks of child as pid==0 for reason given earlier + set pid 0 +} + +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" +spawn -noecho -open [open "|cat $catflags < [infifoname $pid]" "r"] +set in $spawn_id + +puts "Escape sequence is $escape_printable" + +proc prompt1 {} { + global argv0 + + return "$argv0[history nextid]> " +} + +interact { + -reset $escape escape + -output $out + -input $in +} +

dislocate Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: beer.exp =================================================================== --- beer.exp (nonexistent) +++ beer.exp (revision 1765) @@ -0,0 +1,116 @@ +#!/depot/path/expect -f + +# 99 bottles of beer on the wall, Expect-style +# Author: Don Libes + +# 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]] + } +}

beer.exp Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: rftp =================================================================== --- rftp (nonexistent) +++ rftp (revision 1765) @@ -0,0 +1,339 @@ +#!../expect -f +# 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*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 + getdirectory $name $transfer + } - { + # file + if !$transfer return + getfile $name + } l { + # symlink, could be either file or directory + # first assume it's a directory + if [getdirectory $name $transfer] return + if !$transfer return + getfile $name + } default { + send_user "can't figure out what $name is, skipping\n" + } +} + +proc putcurdirectory {} { + send "!/bin/ls -alg\r" + expect timeout { + send_user "failed to get directory listing\n" + return + } "ftp>*" + + set buf $expect_out(buffer) + + for {} 1 {} { + # if end of listing, succeeded! + if 0==[regexp "(\[^\n]*)\n(.*)" $buf dummy line buf] return + + set token [lindex $line 0] + switch -- $token \ + !/bin/ls { + # original command + } total { + # directory header + } . { + # unreadable + } default { + # either file or directory + set name [getname $line] + set type [string index $line 0] + putentry $name $type + } + } +} + + +# look at result of "dir". If transfer==1, get all files and directories +proc getcurdirectory {transfer} { + send "dir\r" + expect timeout { + send_user "failed to get directory listing\n" + return + } "ftp>*" + + set buf $expect_out(buffer) + + for {} 1 {} { + regexp "(\[^\n]*)\n(.*)" $buf dummy line buf + + set token [lindex $line 0] + switch -- $token \ + dir { + # original command + } 200 { + # command successful + } 150 { + # opening data connection + } total { + # directory header + } 226 { + # transfer complete, succeeded! + return + } ftp>* { + # next prompt, failed! + return + } . { + # unreadable + } default { + # either file or directory + set name [getname $line] + set type [string index $line 0] + getentry $name $type $transfer + } + } +} + +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 +}

rftp Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property

Browse

Tools

Subversion Repositories or1k

Compare Revisions

Rev 578 → Rev 1765

Passwd Change Acknowledgment

Error: $s

$s

Change your login password