InfoMagic Source Code 1993 July/THE_SOURCE_CODE_CD_ROM.iso/languages/tcl/expect/expect-4.7/example/kibitz

Text File | 1993-04-12 | 9.6 KB | 405 lines

#!../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:  March 29 1993
# Version: 2.1

# 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

# if you are on a system such as HPUX 8.0 that requires "cat -u" for kibitz
# to work, comment out the following line, and uncomment the next one.
set catflags ""
#set catflags "-u"

trap exit SIGINT

set argv [lrange $argv 1 end]
while [llength $argv]>0 {
    set flag [lindex $argv 0]
    case $flag in \
    "-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]
    } "-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]
    } default {
        break
    }
}

if {([llength $argv]<1) && ($noproc==0)} {
    send_user "usage: kibitz user \[program ...\]\n"
    send_user "   or: kibitz user@host \[program ...\]\n"
    exit
}

# 2nd user invokes it as "kibitz -####" but there is no
# reason to document this, as user is told this on the fly.
# known internally as user_number==2

# 1st user on remote machine invokes it as "kibitz -r user"
# and is known internally as user_number==3 while
# locally known internally as user_number==1

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

#for debugging, uncommenting, leaves each user's session in a file: 1, 2 or 3
#exec rm -f $user_number
#debug -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/resolve.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 {
            set pid [spawn $env(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"}
        spawn rlogin $host
        set userin $spawn_id
        set userout $spawn_id

        if [info exists env(EXPECT_PROMPT)] {
            set prompt $env(EXPECT_PROMPT)
        }

        set timeout 120
        expect {
            assword: {
                system stty -echo
                send_user "password (for [exec whoami]) 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?
                continue -expect
            } incorrect* {
                send_user "invalid password or account\n"
                exit
            } 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 -r $user;kill -9 $$\r"

        expect {
            -re "kibitz -r $user.*KRUN" {}
            -re "kibitz -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)
                continue -expect
            }
            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 [getpid]}

    set userinfile /tmp/exp0.$pid
    set useroutfile /tmp/exp1.$pid
}

proc prompt1 {} {
    return "kibitz[info level].[history nextid]> "
}

if {$allow_escape} {
    expect_before -i $user_spawn_id $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"
    continue -expect
    }

    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 sh -c "stty raw; exec < $userinfile; exec cat $catflags"
    set userin $spawn_id

    set userout [open $useroutfile w]
    # open will hang until other user's cat starts

    system stty -echo raw
    if $allow_escape {send_user "Escape sequence is $escape_printable\n"}

    # While user is reading message, try to delete other fifo
    exec rm -f $userinfile

    expect {
        -i $user_spawn_id -re .+ {
            puts $userout $expect_out(buffer) nonewline
            flush $userout
            continue -expect
        }
        -i $userin -re .+ {
            send_user -raw $expect_out(buffer)
            continue -expect
        }
    }
    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 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
    send_user "Couldn't figure out how to make a fifo - where is mknod?\n"
    abort
    }

    proc rmfifos {} {
    global userinfile useroutfile
    exec rm -f $userinfile $useroutfile
    }

    trap {rmfifos; exit} SIGINT

    # 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}

    set userout [open $useroutfile w]
    # open will hang until other user's cat starts

    spawn sh -c "stty raw; exec < $userinfile; \
                    rm $userinfile; exec cat $catflags"
#    eval spawn cat $catflags $userinfile
    set userin $spawn_id
}

system stty -echo raw

if $user_number==3 {
    send_user "KDATA"    ;# this tells user_number 1 to send data

    interact {
        -output $userout
        -input $userin -output $user_spawn_id -eof {
            wait -i $userin
            return -tcl
        }
    }
} else {
    if $allow_escape {send_user "Escape sequence is $escape_printable\n"}

    if $noproc {
        expect {
            -i $user_spawn_id -re .+ {
                if $local_io {
                    puts $userout $expect_out(buffer) nonewline
                    flush $userout
                } else {
                    send -i $userout $expect_out(buffer)
                }
                continue -expect
            }

            -i $userin -re .+ {
                send_user -raw $expect_out(buffer)
                continue -expect
            } eof {
                wait -i $userin
            }
        }
    } else {
        expect {
            -i $user_spawn_id -re .+ {
                send -i $shell $expect_out(buffer)
                continue -expect
            }

            -i $userin -re .+ {
                send -i $shell $expect_out(buffer)
                continue -expect
            } eof {
                wait -i $userin
                close -i $shell
            }

            -i $shell -re .+ {
                send_user -raw $expect_out(buffer)
                if $local_io {
                   puts $userout $expect_out(buffer) nonewline
                   flush $userout
                } else {
                   send -i $userout $expect_out(buffer)
                }
                continue -expect
            }
        }

        wait -i $shell
    }
}

if $local_io rmfifos