#!/cam8/working/bin/expect -- # run a disconnectable/reconnectable application. # based on Don Lives (NIST) "dislocate" script # If a disconnected process with the given name already exists, this will # reconnect to it. Otherwise, this will start a new one. # This program creates files "~/.processname.hostname" to keep track # of user processes on various machines. exp_version -exit 5.1 set catflags "" set escape \034 ;# ^\ set suspend \032 ;# ^Z set prefix "disc" set timeout -1 set debug_flag 0 while {$argc} { set flag [lindex $argv 0] switch -- $flag \ "-debug" { log_file [lindex $argv 1] set debug_flag 1 set argv [lrange $argv 2 end] incr argc -2 } default { break } } set arg [lindex $argv 0] if {[llength $arg]==0} { puts "Needs an argument!" exit } if [regexp "(.*)/(.*)$" $arg whole basename procname] { set pidfile "~/.$procname.[exec hostname]" } else { set pidfile "~/.$arg.[exec hostname]" } # 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 {close -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 "\nDisconnected.\n" if [fork]!=0 exit disconnect } # 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 } } ######################################################################### # Now ignore argv if process already running: set count 0 if [file exists $pidfile] { global fifos date proc pidfile_read foreach pid [array names date] { incr count } } if {$argc && ($count==0)} { # initial creation occurs before fork because if we do it after # then either the child or the parent may have to spin retrying # the fifo open. Unfortunately, we cannot know the pid ahead of # time so use "0". This will be set to the real pid when the # parent does its initial disconnect. There is no collision # problem because the fifos are deleted immediately anyway. set datearg [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 if $count==0 { say "starting new process" } elseif $count==1 { puts "Reconnected to pid $pid, started $date($pid)." } 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] } } else { puts "Needs an argument!" exit } 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 proc prompt1 {} { global argv0 return "$argv0[history nextid]> " } interact { -reset $escape escape $suspend escape -output $out -input $in }