home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / bin / dislocate < prev    next >
Encoding:
Text File  |  1995-07-22  |  7.1 KB  |  341 lines
  1. #!/usr/skunk/bin/expect --
  2. # dislocate - allow disconnection and reconnection to a background program
  3. # Author: Don Libes, NIST
  4.  
  5. exp_version -exit 5.1
  6.  
  7. # The following code attempts to intuit whether cat buffers by default.
  8. # The -u flag is required on HPUX (8 and 9) and IBM AIX (3.2) systems.
  9. if [file exists $exp_exec_library/cat-buffers] {
  10.     set catflags "-u"
  11. } else {
  12.     set catflags ""
  13. }
  14. # If this fails, you can also force it by commenting in one of the following.
  15. # Or, you can use the -catu flag to the script.
  16. #set catflags ""
  17. #set catflags "-u"
  18.  
  19. set escape \035            ;# control-right-bracket
  20. set escape_printable "^\]"
  21.  
  22. set pidfile "~/.dislocate"
  23. set prefix "disc"
  24. set timeout -1
  25. set debug_flag 0
  26.  
  27. while {$argc} {
  28.     set flag [lindex $argv 0]
  29.     switch -- $flag \
  30.     "-catu" {
  31.         set catflags "-u"
  32.         set argv [lrange $argv 1 end]
  33.         incr argc -1
  34.     } "-escape" {
  35.         set escape [lindex $argv 1]
  36.         set escape_printable $escape
  37.         set argv [lrange $argv 2 end]
  38.         incr argc -2
  39.     } "-debug" {
  40.         log_file [lindex $argv 1]
  41.         set debug_flag 1
  42.         set argv [lrange $argv 2 end]
  43.         incr argc -2
  44.     } default {
  45.         break
  46.     }
  47. }
  48.  
  49. # These are correct from parent's point of view.
  50. # In child, we will reset these so that they appear backwards
  51. # thus allowing following two routines to be used by both parent and child
  52. set  infifosuffix ".i"
  53. set outfifosuffix ".o"
  54.  
  55. proc infifoname {pid} {
  56.     global prefix infifosuffix
  57.  
  58.     return "/tmp/$prefix$pid$infifosuffix"
  59. }
  60.  
  61. proc outfifoname {pid} {
  62.     global prefix outfifosuffix
  63.  
  64.     return "/tmp/$prefix$pid$outfifosuffix"
  65. }
  66.  
  67. proc pid_remove {pid} {
  68.     global date proc
  69.  
  70.     say "removing $pid $proc($pid)"
  71.  
  72.     unset date($pid)
  73.     unset proc($pid)
  74. }
  75.  
  76. # lines in data file looks like this:
  77. # pid#date-started#argv
  78.  
  79. # allow element lookups on empty arrays
  80. set date(dummy) dummy;    unset date(dummy)
  81. set proc(dummy) dummy;    unset proc(dummy)
  82.  
  83. # load pidfile into memory
  84. proc pidfile_read {} {
  85.     global date proc pidfile
  86.  
  87.     if [catch {open $pidfile} fp] return
  88.  
  89.     #
  90.     # read info out of file
  91.     #
  92.  
  93.     say "reading pidfile"
  94.     set line 0
  95.     while {[gets $fp buf]!=-1} {
  96.         # while pid and date can't have # in it, proc can
  97.         if [regexp "(\[^#]*)#(\[^#]*)#(.*)" $buf junk pid xdate xproc] {
  98.             set date($pid) $xdate
  99.             set proc($pid) $xproc
  100.         } else {
  101.             puts "warning: inconsistency in $pidfile line $line"
  102.         }
  103.         incr line
  104.     }
  105.     close $fp
  106.     say "read $line entries"
  107.  
  108.     #
  109.     # see if pids and fifos are still around
  110.     #
  111.  
  112.     foreach pid [array names date] {
  113.         if {$pid && [catch {exec /bin/kill -0 $pid}]} {
  114.             say "$pid no longer exists, removing"
  115.             pid_remove $pid
  116.             continue
  117.         }
  118.  
  119.         # pid still there, see if fifos are
  120.         if {![file exists [infifoname $pid]] || ![file exists [outfifoname $pid]]} {
  121.             say "$pid fifos no longer exists, removing"
  122.             pid_remove $pid
  123.             continue
  124.         }
  125.     }
  126. }
  127.  
  128. proc pidfile_write {} {
  129.     global pidfile date proc
  130.  
  131.     say "writing pidfile"
  132.  
  133.     set fp [open $pidfile w]
  134.     foreach pid [array names date] {
  135.         puts $fp "$pid#$date($pid)#$proc($pid)"
  136.         say "wrote $pid#$date($pid)#$proc($pid)"
  137.     }
  138.     close $fp
  139. }
  140.  
  141. proc fifo_pair_remove {pid} {
  142.     global date proc prefix
  143.  
  144.     pidfile_read
  145.     pid_remove $pid
  146.     pidfile_write
  147.  
  148.     catch {exec rm -f [infifoname $pid] [outfifoname $pid]}
  149. }
  150.  
  151. proc fifo_pair_create {pid argdate argv} {
  152.     global prefix date proc
  153.  
  154.     pidfile_read
  155.     set date($pid) $argdate
  156.     set proc($pid) $argv
  157.     pidfile_write
  158.  
  159.     mkfifo [infifoname $pid]
  160.     mkfifo [outfifoname $pid]
  161. }
  162.  
  163. proc mkfifo {f} {
  164.     if [file exists $f] {
  165.         say "uh, fifo already exists?"
  166.         return
  167.     }
  168.  
  169.     if 0==[catch {exec mkfifo $f}] return        ;# POSIX
  170.     if 0==[catch {exec mknod $f p}] return
  171.     # some systems put mknod in wierd places
  172.     if 0==[catch {exec /usr/etc/mknod $f p}] return    ;# Sun
  173.     if 0==[catch {exec /etc/mknod $f p}] return    ;# AIX, Cray
  174.     puts "Couldn't figure out how to make a fifo - where is mknod?"
  175.     exit
  176. }
  177.  
  178. proc child {argdate argv} {
  179.     global catflags infifosuffix outfifosuffix
  180.  
  181.     disconnect
  182.  
  183.     # these are backwards from the child's point of view so that
  184.     # we can make everything else look "right"
  185.     set  infifosuffix ".o"
  186.     set outfifosuffix ".i"
  187.     set pid 0
  188.  
  189.     eval spawn $argv
  190.     set proc_spawn_id $spawn_id
  191.  
  192.     while {1} {
  193.         say "opening [infifoname $pid] for read"
  194.          spawn -open [open "|cat $catflags < [infifoname $pid]" "r"]
  195.         set in $spawn_id
  196.  
  197.         say "opening [outfifoname $pid] for write"
  198.         spawn -open [open [outfifoname $pid] w]
  199.         set out $spawn_id
  200.  
  201.         fifo_pair_remove $pid
  202.  
  203.         say "interacting"
  204.         interact {
  205.             -u $proc_spawn_id eof exit
  206.             -output $out
  207.             -input $in
  208.         }
  209.  
  210.         # parent has closed connection
  211.         say "parent closed connection"
  212.         catch {close -i $in}
  213.         catch {close -i $out}
  214.  
  215.         # switch to using real pid
  216.         set pid [pid]
  217.         # put entry back
  218.         fifo_pair_create $pid $argdate $argv
  219.     }
  220. }
  221.  
  222. proc say {msg} {
  223.     global debug_flag
  224.  
  225.     if !$debug_flag return
  226.  
  227.     if [catch {puts "parent: $msg"}] {
  228.         send_log "child: $msg\n"
  229.     }
  230. }
  231.  
  232. proc escape {} {
  233.     # export process handles so that user can get at them
  234.     global in out
  235.  
  236.     puts "\nto disconnect, enter: exit (or ^D)"
  237.     puts "to suspend, press appropriate job control sequence"
  238.     puts "to return to process, enter: return"
  239.     interpreter
  240.     puts "returning ..."
  241. }
  242.  
  243. # interactively query user to choose process, return pid
  244. proc choose {} {
  245.     global index date
  246.  
  247.     while 1 {
  248.         send_user "enter # or pid: "
  249.         expect_user -re "(.*)\n" {set buf $expect_out(1,string)}
  250.         if [info exists index($buf)] {
  251.             set pid $index($buf)
  252.         } elseif [info exists date($buf)] {
  253.             set pid $buf
  254.         } else {
  255.             puts "no such # or pid"
  256.             continue
  257.         }
  258.         return $pid
  259.     }
  260. }
  261.  
  262. if {$argc} {
  263.     # initial creation occurs before fork because if we do it after
  264.     # then either the child or the parent may have to spin retrying
  265.     # the fifo open.  Unfortunately, we cannot know the pid ahead of
  266.     # time so use "0".  This will be set to the real pid when the
  267.     # parent does its initial disconnect.  There is no collision
  268.     # problem because the fifos are deleted immediately anyway.
  269.  
  270.     set datearg [exec date]
  271.     fifo_pair_create 0 $datearg $argv
  272.  
  273.     set pid [fork]
  274.     say "after fork, pid = $pid"
  275.     if $pid==0 {
  276.         child $datearg $argv
  277.     }
  278.     # parent thinks of child as pid==0 for reason given earlier
  279.     set pid 0
  280. }
  281.  
  282. say "examining pid"
  283.  
  284. if ![info exists pid] {
  285.     global fifos date proc
  286.  
  287.     say "pid does not exist"
  288.  
  289.     pidfile_read
  290.  
  291.     set count 0
  292.     foreach pid [array names date] {
  293.         incr count
  294.     }
  295.  
  296.     if $count==0 {
  297.         puts "no connectable processes"
  298.         exit
  299.     } elseif $count==1 {
  300.         puts "one connectable process: $proc($pid)"
  301.         puts "pid $pid, started $date($pid)"
  302.         send_user "connect? \[y] "
  303.         expect_user -re "(.*)\n" {set buf $expect_out(1,string)}
  304.         if {$buf!="y" && $buf!=""} exit
  305.     } else {
  306.         puts "connectable processes:"
  307.         set count 1
  308.         puts " #   pid      date started      process"
  309.         foreach pid [array names date] {
  310.             puts [format "%2d %6d  %.19s  %s" \
  311.                 $count $pid $date($pid) $proc($pid)]
  312.             set index($count) $pid
  313.             incr count
  314.         }
  315.         set pid [choose]
  316.     }
  317. }
  318.  
  319. say "opening [outfifoname $pid] for write"
  320. spawn -noecho -open [open [outfifoname $pid] w]
  321. set out $spawn_id
  322.  
  323. say "opening [infifoname $pid] for read"
  324. spawn -noecho -open [open "|cat $catflags < [infifoname $pid]" "r"]
  325. set in $spawn_id
  326.  
  327. puts "Escape sequence is $escape_printable"
  328.  
  329. proc prompt1 {} {
  330.     global argv0
  331.  
  332.     return "$argv0[history nextid]> "
  333. }
  334.  
  335. interact {
  336.     -reset $escape escape
  337.     -output $out
  338.     -input $in
  339. }
  340.  
  341.