URL
https://opencores.org/ocsvn/or1k/or1k/trunk
Subversion Repositories or1k
[/] [or1k/] [trunk/] [insight/] [expect/] [example/] [kibitz] - Rev 1776
Go to most recent revision | Compare with Previous | Blame | View Log
#!../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
Go to most recent revision | Compare with Previous | Blame | View Log