This file is indexed.

/usr/bin/expect_dislocate is in expect 5.45-6.

This file is owned by root:root, with mode 0o755.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
#!/bin/sh
# -*- tcl -*-
# The next line is executed by /bin/sh, but not tcl \
exec tclsh8.6 "$0" ${1+"$@"}

package require Expect


# dislocate - allow disconnection and reconnection to a background program
# Author: Don Libes, NIST

exp_version -exit 5.1

# The following code attempts to intuit whether cat buffers by default.
# The -u flag is required on HPUX (8 and 9) and IBM AIX (3.2) systems.
if {[file exists $exp_exec_library/cat-buffers]} {
    set catflags "-u"
} else {
    set catflags ""
}
# If this fails, you can also force it by commenting in one of the following.
# Or, you can use the -catu flag to the script.
#set catflags ""
#set catflags "-u"

set escape \035			;# control-right-bracket
set escape_printable "^\]"

set pidfile "~/.dislocate"
set prefix "disc"
set timeout -1
set debug_flag 0

while {$argc} {
    set flag [lindex $argv 0]
    switch -- $flag \
	    "-catu" {
	set catflags "-u"
	set argv [lrange $argv 1 end]
	incr argc -1
    } "-escape" {
	set escape [lindex $argv 1]
	set escape_printable $escape
	set argv [lrange $argv 2 end]
	incr argc -2
    } "-debug" {
	log_file [lindex $argv 1]
	set debug_flag 1
	set argv [lrange $argv 2 end]
	incr argc -2
    } default {
	break
    }
}

# These are correct from parent's point of view.
# In child, we will reset these so that they appear backwards
# thus allowing following two routines to be used by both parent and child
set  infifosuffix ".i"
set outfifosuffix ".o"

proc infifoname {pid} {
    return "/tmp/$::prefix$pid$::infifosuffix"
}

proc outfifoname {pid} {
    return "/tmp/$::prefix$pid$::outfifosuffix"
}

proc pid_remove {pid} {
    say "removing $pid $::proc($pid)"

    unset ::date($pid)
    unset ::proc($pid)
}

# lines in data file look like this:
# pid#date-started#argv

# allow element lookups on empty arrays
set date(dummy) dummy;	unset date(dummy)
set proc(dummy) dummy;	unset proc(dummy)

proc say {msg} {
    if {!$::debug_flag} return

    if {[catch {puts "parent: $msg"}]} {
	send_log "child: $msg\n"
    }
}

# load pidfile into memory
proc pidfile_read {} {
    global date proc pidfile

    say "opening $pidfile"
    if {[catch {open $pidfile} fp]} return

    #
    # read info from file
    #

    say "reading pidfile"
    set line 0
    while {[gets $fp buf]!=-1} {
	# while pid and date can't have # in it, proc can
	if {[regexp "(\[^#]*)#(\[^#]*)#(.*)" $buf junk pid xdate xproc]} {
	    set date($pid) $xdate
	    set proc($pid) $xproc
	} else {
	    puts "warning: inconsistency in $pidfile line $line"
	}
	incr line
    }
    close $fp
    say "read $line entries"

    #
    # see if pids and fifos are still around
    #

    foreach pid [array names date] {
	if {$pid && [catch {exec /bin/kill -0 $pid}]} {
	    say "$pid no longer exists, removing"
	    pid_remove $pid
	    continue
	}

	# pid still there, see if fifos are
	if {![file exists [infifoname $pid]] || ![file exists [outfifoname $pid]]} {
	    say "$pid fifos no longer exists, removing"
	    pid_remove $pid
	    continue
	}
    }
}

proc pidfile_write {} {
    global pidfile date proc

    say "writing pidfile"

    set fp [open $pidfile w]
    foreach pid [array names date] {
	puts $fp "$pid#$date($pid)#$proc($pid)"
	say "wrote $pid#$date($pid)#$proc($pid)"
    }
    close $fp
}

proc fifo_pair_remove {pid} {
    global date proc prefix

    pidfile_read
    pid_remove $pid
    pidfile_write

    file delete -force [infifoname $pid] [outfifoname $pid]
}

proc fifo_pair_create {pid argdate argv} {
    global prefix date proc

    pidfile_read
    set date($pid) $argdate
    set proc($pid) $argv
    pidfile_write

    mkfifo [infifoname $pid]
    mkfifo [outfifoname $pid]
}

proc mkfifo {f} {
    if {[file exists $f]} {
	say "uh, fifo already exists?"
	return
    }

    if {0==[catch {exec mkfifo $f}]} return		;# POSIX
    if {0==[catch {exec mknod $f p}]} return
    # some systems put mknod in wierd places
    if {0==[catch {exec /usr/etc/mknod $f p}]} return	;# Sun
    if {0==[catch {exec /etc/mknod $f p}]} return	;# AIX, Cray
    puts "Couldn't figure out how to make a fifo - where is mknod?"
    exit
}

proc child {argdate argv} {
    global infifosuffix outfifosuffix

    disconnect
    # these are backwards from the child's point of view so that
    # we can make everything else look "right"
    set  infifosuffix ".o"
    set outfifosuffix ".i"
    set pid 0

    eval spawn $argv
    set proc_spawn_id $spawn_id

    while {1} {
	say "opening [infifoname $pid] for read"
	
	set catfid [open "|cat $::catflags < [infifoname $pid]" "r"]
	set ::catpid $catfid
	spawn -open $catfid
	set in $spawn_id

	say "opening [outfifoname $pid] for write"
	spawn -open [open [outfifoname $pid] w]
	set out $spawn_id

	fifo_pair_remove $pid

	say "interacting"
	interact {
	    -u $proc_spawn_id eof exit
	    -output $out
	    -input $in
	}

	# parent has closed connection
	say "parent closed connection"
	catch {close -i $in}
	catch {wait -i $in}
	catch {close -i $out}
	catch {wait -i $out}

	# switch to using real pid
	set pid [pid]
	# put entry back
	fifo_pair_create $pid $argdate $argv
    }
}

proc escape {} {
    # export process handles so that user can get at them
    global in out

    puts "\nto disconnect, enter: exit (or ^D)"
    puts "to suspend, press appropriate job control sequence"
    puts "to return to process, enter: return"
    interpreter -eof exit
    puts "returning ..."
}

# interactively query user to choose process, return pid
proc choose {} {
    while {1} {
	send_user "enter # or pid: "
	expect_user -re "(.*)\n" {set buf $expect_out(1,string)}
	if {[info exists ::index($buf)]} {
	    set pid $::index($buf)
	} elseif {[info exists ::date($buf)]} {
	    set pid $buf
	} else {
	    puts "no such # or pid"
	    continue
	}
	return $pid
    }
}

if {$argc} {
    # initial creation occurs before fork because if we do it after
    # then either the child or the parent may have to spin retrying
    # the fifo open.  Unfortunately, we cannot know the pid ahead of
    # time so use "0".  This will be set to the real pid when the
    # parent does its initial disconnect.  There is no collision
    # problem because the fifos are deleted immediately anyway.

    set datearg [clock format [clock seconds]]

    fifo_pair_create 0 $datearg $argv

    # to debug by faking child, comment out fork and set pid to a
    # non-zero int, then you can read/write to pipes manually

    set pid [fork]
    say "after fork, pid = $pid"
    if {$pid==0} {
	child $datearg $argv
    }

    # parent thinks of child as pid==0 for reason given earlier
    set pid 0
}

say "examining pid"

if {![info exists pid]} {
    global fifos date proc

    say "pid does not exist"

    pidfile_read

    set count 0
    foreach pid [array names date] {
	incr count
    }

    if {$count==0} {
	puts "no connectable processes"
	exit
    } elseif {$count==1} {
	puts "one connectable process: $proc($pid)"
	puts "pid $pid, started $date($pid)"
	send_user "connect? \[y] "
	expect_user -re "(.*)\n" {set buf $expect_out(1,string)}
	if {$buf!="y" && $buf!=""} exit
    } else {
	puts "connectable processes:"
	set count 1
	puts " #   pid      date started      process"
	foreach pid [array names date] {
	    puts [format "%2d %6d  %.19s  %s" \
		    $count $pid $date($pid) $proc($pid)]
	    set index($count) $pid
	    incr count
	}
	set pid [choose]
    }
}

say "opening [outfifoname $pid] for write"
spawn -noecho -open [open [outfifoname $pid] w]
set out $spawn_id

say "opening [infifoname $pid] for read"
set catfid [open "|cat $catflags < [infifoname $pid]" "r"]
set catpid [pid $catfid]
spawn -noecho -open $catfid
set in $spawn_id

puts "Escape sequence is $escape_printable"

proc prompt1 {} {
    return "$::argv0[history nextid]> "
}

rename exit exitReal

proc exit {} {
    exec /bin/kill $::catpid
    exitReal
}

interact {
    -reset $escape escape
    -output $out
    -input $in
}