utilities/shellbox.tcl

#!/usr/bin/tclsh

# shellbox.tcl
#
# 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 dives a list of all connected clients
#    kill terminates the shell
#

set version {$Id: shellbox.tcl,v 1.2 2002/10/23 09:22:46 zimoch Exp $}

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

proc bgerror {args} {
    global errorInfo
    puts stderr $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 line
    fileevent $channel readable "inputHandler $channel"
    forwardOutput "**** new client $clientinfo($channel) ****"
    puts $channel "**** '$command' running ****"
    lappend channels $channel
    puts $channel "clients:\n[getClientlist]"
    forwardInput "\n"
}

proc closeChannel {channel} {
    global channels clientinfo
    puts "closing connection to $clientinfo($channel)"
    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} {
    set data [read $channel]
    if [eof $channel] {
        closeChannel $channel
        return
    }
    binary scan $data H* hex
    switch $data {
        "clients\n" {forwardOutput "clients:\n[getClientlist]"}
        "exit\n"    {closeChannel $channel}
        "quit\n"    {closeChannel $channel}
        "kill\n"    {killProgram}
        default   {
            switch $hex {
                fff4fffd06 {closeChannel $channel}
                04         {closeChannel $channel}
                ffedfffd06 {closeChannel $channel}
                default    {forwardInput $data}
            }
        }
    }
}

proc forwardInput {data} {
    global pipe
    puts -nonewline $pipe $data
}

proc outputHandler {channel} {
    set data [read $channel]
    if [eof $channel] {
        global command
        forwardOutput "**** '$command' died ****\n"
        startProgram
        return
    }
    forwardOutput $data
}

proc forwardOutput {data} {
    global channels
    catch {puts -nonewline $data}
    foreach channel $channels {
        catch {puts -nonewline $channel $data}
    }
}

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

proc startProgram {} {
    global command pipe
    catch {close $pipe}
    if [catch {
        set pipe [open "|$command" RDWR]
    } msg] {
        puts stderr $msg
        exit 3
    }
    fconfigure $pipe -blocking no -buffering line
    gets $pipe
    if [eof $pipe] exit
    fileevent $pipe readable "outputHandler $pipe"
    forwardOutput "**** '$command' started ****\n"
}

proc killProgram {} {
    global pipe command
    close $pipe
    forwardOutput "**** '$command' killed ****\n"
    startProgram
}

if {[lindex $argv 0] == "-v"} {
    puts $version
    exit 0
}

if {[lindex $argv 0] == "-paranoid"} {
    set paranoid 1
    set argv [lrange $argv 1 end]
} else {
    set paranoid 0
}

set port [lindex $argv 0]
set command [lrange $argv 1 end]
if {![string is integer $port] || [llength $command] == 0} {
    puts stderr "usage: [file tail $argv0] \[-paranoid\] <port> <command> \[args\]"
    exit 1
}

startProgram
createServer $port $paranoid
vwait forever