exec expect
-- "$0" ${1+"$@"}
# dislocate - allow disconnection and reconnection to a background program
# Author: Don Libes, NIST
# 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
]} {
# 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 escape
\035 ;# control-right-bracket
set escape_printable
"^\]"
set pidfile
"~/.dislocate"
set flag
[lindex
$argv 0]
set argv
[lrange
$argv 1 end
]
set escape
[lindex
$argv 1]
set escape_printable
$escape
set argv
[lrange
$argv 2 end
]
log_file
[lindex
$argv 1]
set argv
[lrange
$argv 2 end
]
# 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
return "/tmp/$::prefix$pid$::infifosuffix"
return "/tmp/$::prefix$pid$::outfifosuffix"
say
"removing $pid $::proc($pid)"
# lines in data file look like this:
# allow element lookups on empty arrays
set date(dummy
) dummy
; unset date(dummy
)
set proc
(dummy
) dummy
; unset proc
(dummy
)
if {!$
::debug_flag
} return
if {[catch
{puts
"parent: $msg"}]} {
# load pidfile into memory
if {[catch
{open
$pidfile} fp
]} return
while {[gets
$fp buf
]!=-1} {
# while pid and date can't have # in it, proc can
if {[regexp
"(\[^#]*)#(\[^#]*)#(.*)" $buf junk pid xdate xproc
]} {
puts
"warning: inconsistency in $pidfile line $line"
# 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 still there, see if fifos are
if {![file exists
[infifoname
$pid]] ||
![file exists
[outfifoname
$pid]]} {
say
"$pid fifos no longer exists, removing"
foreach pid
[array names
date] {
puts
$fp "$pid#$date($pid)#$proc($pid)"
say
"wrote $pid#$date($pid)#$proc($pid)"
proc fifo_pair_remove
{pid
} {
file delete
-force [infifoname
$pid] [outfifoname
$pid]
proc fifo_pair_create
{pid argdate argv
} {
mkfifo [outfifoname
$pid]
say
"uh, fifo already exists?"
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?"
proc child
{argdate argv
} {
global infifosuffix outfifosuffix
# these are backwards from the child's point of view so that
# we can make everything else look "right"
set proc_spawn_id
$spawn_id
say
"opening [infifoname $pid] for read"
set catfid
[open
"|cat $::catflags < [infifoname $pid]" "r"]
say
"opening [outfifoname $pid] for write"
spawn
-open [open
[outfifoname
$pid] w
]
-u $proc_spawn_id eof
exit
# parent has closed connection
say
"parent closed connection"
# switch to using real pid
fifo_pair_create
$pid $argdate $argv
# export process handles so that user can get at them
puts
"\nto disconnect, enter: exit (or ^D)"
puts
"to suspend, press appropriate job control sequence"
puts
"to return to process, enter: return"
# interactively query user to choose process, return pid
send_user
"enter # or pid: "
expect_user
-re "(.*)\n" {set buf
$expect_out(1,string
)}
if {[info exists
::index
($buf)]} {
} elseif
{[info exists
::date($buf)]} {
# initial creation occurs before fork because if we do it after
# then either the child or the parent may have to spin retrying
# the fifo open. Unfortunately, we cannot know the pid ahead of
# time so use "0". This will be set to the real pid when the
# parent does its initial disconnect. There is no collision
# problem because the fifos are deleted immediately anyway.
set datearg
[clock format
[clock seconds
]]
fifo_pair_create
0 $datearg $argv
# to debug by faking child, comment out fork and set pid to a
# non-zero int, then you can read/write to pipes manually
say
"after fork, pid = $pid"
# parent thinks of child as pid==0 for reason given earlier
if {![info exists pid
]} {
foreach pid
[array names
date] {
puts
"no connectable processes"
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
puts
"connectable processes:"
puts
" # pid date started process"
foreach pid
[array names
date] {
puts
[format
"%2d %6d %.19s %s" \
$count $pid $date($pid) $proc($pid)]
say
"opening [outfifoname $pid] for write"
spawn
-noecho -open [open
[outfifoname
$pid] w
]
say
"opening [infifoname $pid] for read"
set catfid
[open
"|cat $catflags < [infifoname $pid]" "r"]
spawn
-noecho -open $catfid
puts
"Escape sequence is $escape_printable"
return "$::argv0[history nextid]> "