utilities/shellbox.tcl

#!/bin/bash
# shellbox
#
# This program serves as a box that runs a shell in it.
# stdout and stdin of the shell are connected to the box.
# If the shell uses stderr, you should wrap it in a script
# that redirects stderr to stdout.
#
# Whenever the shell dies, it will be restarted.
#
# Clients can connect to the box via TCP (e.g. with telnet).
# Any number of clients can connect at the same time. Input
# of all clients is merged. Output of the shell is broadcasted
# to all clients and to stdout of the box.
#
# When started with the -paranoid option, the box only accepts
# connections from localhost.
#
# The box intercepts the following commands:
#    exit or quit disconnect from the box
#    clients gives a list of all connected clients
#    kill terminates the shell
#
#\
source /etc/profile
#\
exec tclsh "$0" "$@"

package req Expect
log_user 0
set timeout -1

regsub -all {\$} {shellbox by Dirk Zimoch
$Source: /cvs/G/EPICS/App/scripts/shellbox.tcl,v $
$Revision: 1.10 $
$Date: 2013/07/11 09:49:48 $} {} version

proc usage {} {
    puts "usage: shellbox \[options\] port command args"
    puts "options: -help          : show this text"
    puts "         -version       : show cvs release"
    puts "         -paranoid      : allow connections from localhost only"
    puts "         -dir directory : set working directory"
}

proc createServer {port} {
    global paranoid
    if [catch {
        if $paranoid {
            socket -server connectionHandler -myaddr localhost $port
        } else {
            socket -server connectionHandler $port
        }
    } msg] {
        puts stderr "shellbox: Can't install server on port $port"
        puts stderr $msg
        exit 2
    }
    puts "server started on port $port"
}

proc bgerror {args} {
    global errorInfo
    catch {puts stderr "shellbox: $errorInfo"}
}

set channels {}

proc connectionHandler {channel addr port} {
    global channels command clientinfo
    set peer [fconfigure $channel -peername]
    set clientinfo($channel) [lindex $peer 1]:[lindex $peer 2]
    fconfigure $channel -blocking no -buffering none -encoding binary
    # do some telnet magic to change from line-mode to char-mode
    puts -nonewline $channel "\xff\xfb\x03\xff\xfb\x01"
    fileevent $channel readable "inputHandler $channel"
    forwardOutput "**** new client $clientinfo($channel) ****\n"
    catch {puts $channel "**** '$command' running ****"}
    lappend channels $channel
    catch {puts $channel "clients:\n[getClientlist]"}
    send "\n"
}

proc closeChannel {channel} {
    global channels clientinfo
    catch {puts $channel "**** see you later ****"}
    set index [lsearch $channels $channel]
    set channels [lreplace $channels $index $index]
    forwardOutput "**** client $clientinfo($channel) logged out ****\n"
    close $channel
    unset clientinfo($channel)
}

proc inputHandler {channel} {
    global echo
    set data [read $channel]
    if [eof $channel] {
        closeChannel $channel
        return
    }
    binary scan $data H* hex
    switch -glob -- $hex {
        03         {closeChannel $channel}
        04         {closeChannel $channel}
        18         {killProgram}
        fff4fffd06 {closeChannel $channel}
        ffedfffd06 {closeChannel $channel}
        ff*        {puts "ignored $data"}
        default    {send -- $data}
    }
}

proc forwardOutput {data {exclude ""}} {
    global channels
    catch {puts -nonewline $data}
    foreach channel $channels {
        if {$channel != $exclude} {
            catch {puts -nonewline $channel $data}
        }
    }
}

proc getClientlist {} {
    global channels clientinfo
    set result ""
    foreach channel $channels {
        append result "$clientinfo($channel)\n"
    }
    return $result
}

set diedyoung 1
proc startProgram {} {
    global command spawn_id diedyoung directory
#    catch {close $spawn_id}
    if {[catch {cd $directory} msg]} {
        forwardOutput "**** $msg (trying later) ****\n"
        while {[catch {cd $directory}]} { after 10000 }
    }
    after 10000 set diedyoung 0
    if [catch {
        eval spawn $command
    } msg] {
        catch {puts stderr "shellbox: $msg"}
        exit 3
    }
    forwardOutput "**** '$command' (pid [exp_pid]) started in [pwd] ****\n"
    expect_background {
        "kill" {
            killProgram
        }
        ? {
            forwardOutput $expect_out(buffer)
        }
        eof {
            forwardOutput "**** '$command' (pid [exp_pid]) sent EOF ****\n"
            wait [exp_pid]
            if ($diedyoung) {
                forwardOutput "**** first run died within first 10 seconds. I will quit. ****\n"
                exit 4
            }
            forwardOutput "**** '$command' died ****\n"
            after idle startProgram
        }
    }
}

proc killProgram {} {
    global command spawn_id
    forwardOutput "**** killing '$command' (pid [exp_pid])****\n"
    if [catch {exec kill -s SIGHUP [exp_pid]} msg] {forwardOutput "**** hangup failed: $msg ****\n"}
    after 1000
    if [catch {exec kill -s SIGKILL [exp_pid]} msg] {forwardOutput "**** kill failed: $msg ****\n"}
    after 1000
    forwardOutput "**** '$command' killed ****\n"
    wait [exp_pid]
    expect "*"
}

set paranoid 0
set directory .

while {[string match -* $argv]} {
    switch -exact -- [lindex $argv 0] {
        "-?" - "-help" { usage; exit 0 }
        "-v" - "-version" {puts $version; exit 0}
        "-paranoid" {set paranoid 1}
        "-echo" {puts stderr "shellbox: option -echo is obsolete"}
        "-dir" {
            set directory [lindex $argv 1]
            set argv [lrange $argv 2 end]
            continue
        }
        default {puts stderr "shellbox: unknown option [lindex $argv 0]"; usage; exit 1}
    }
    set argv [lrange $argv 1 end]
}

set port [lindex $argv 0]
set command [lrange $argv 1 end]
if {![regexp {^[0-9]+$} $port] || [llength $command] == 0} {
    usage; exit 1
}

fconfigure stdout -buffering none
startProgram
createServer $port
vwait forever