epics/utilities
0
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

many fixes for SL5

Browse Source
This commit is contained in:
zimoch
2009-03-12 16:51:31 +00:00
parent 5059cb2359
commit 691d499cc1
1 changed files with 78 additions and 71 deletions
Download Patch File Download Diff File Expand all files Collapse all files

149
shellbox.tcl
View File

@@ -1,6 +1,5 @@
#!/usr/bin/tclsh
# 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.
@@ -22,11 +21,29 @@
# clients gives a list of all connected clients
# kill terminates the shell
#
#\
source /etc/profile
#\
unset LANG
#\
exec tclsh "$0" "$@"
regsub -all {\$} {shellbox.tcl by Dirk Zimoch
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.6 $
$Date: 2003/06/26 12:55:49 $} {} version
$Revision: 1.7 $
$Date: 2009/03/12 16:51:31 $} {} 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
@@ -37,7 +54,7 @@ proc createServer {port} {
socket -server connectionHandler $port
}
} msg] {
puts stderr "Can't install server on port $port"
puts stderr "shellbox: Can't install server on port $port"
puts stderr $msg
exit 2
}
@@ -46,7 +63,7 @@ proc createServer {port} {
proc bgerror {args} {
global errorInfo
catch {puts stderr $errorInfo}
catch {puts stderr "shellbox: $errorInfo"}
}
set channels {}
@@ -56,12 +73,14 @@ proc connectionHandler {channel addr port} {
set peer [fconfigure $channel -peername]
set clientinfo($channel) [lindex $peer 1]:[lindex $peer 2]
fconfigure $channel -blocking no -buffering none
# 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]"}
forwardInput "\n"
send "\n"
}
proc closeChannel {channel} {
@@ -81,44 +100,18 @@ proc inputHandler {channel} {
closeChannel $channel
return
}
if $echo {forwardOutput $data $channel}
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}
}
}
switch -glob -- $hex {
03 {closeChannel $channel}
04 {closeChannel $channel}
18 {killProgram}
fff4fffd06 {closeChannel $channel}
ffedfffd06 {closeChannel $channel}
ff* {puts "ignored $data"}
default {puts $hex; send -- $data}
}
}
proc forwardInput {data} {
global pipe
catch {puts -nonewline $pipe $data}
}
proc outputHandler {channel} {
set data [read $channel]
if [eof $channel] {
global command diedyoung
if $diedyoung {
forwardOutput "**** first run of '$command' died within first 10 seconds. I will quit. ****\n"
exit 4
}
forwardOutput "**** '$command' died ****\n"
startProgram
return
}
forwardOutput $data
}
proc forwardOutput {data {exclude ""}} {
global channels
catch {puts -nonewline $data}
@@ -140,49 +133,64 @@ proc getClientlist {} {
set diedyoung 1
proc startProgram {} {
global command pipe diedyoung
catch {close $pipe}
after 10000 set diedyoung 0
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 1000 set diedyoung 0
if [catch {
set pipe [open |$command RDWR]
eval spawn $command
} msg] {
catch {puts stderr $msg}
catch {puts stderr "shellbox: $msg"}
exit 3
}
fconfigure $pipe -blocking no -buffering none
gets $pipe
if [eof $pipe] {
forwardOutput "**** '$command' died immediately. I will quit ****\n"
exit 5
forwardOutput "**** '$command' started in [pwd] ****\n"
expect_background {
kill {
killProgram
}
? {
forwardOutput $expect_out(buffer)
}
eof {
puts "EOF received"
if ($diedyoung) {
forwardOutput $expect_out(buffer)
forwardOutput "**** first run of '$command' died within first 10 seconds. I will quit. ****\n"
exit 4
}
forwardOutput $expect_out(buffer)
forwardOutput "**** '$command' died ****\n"
after idle startProgram
}
}
fileevent $pipe readable "outputHandler $pipe"
forwardOutput "**** '$command' started ****\n"
}
proc killProgram {} {
global pipe command
close $pipe
global command
forwardOutput "**** killing '$command' ****\n"
exec kill -s SIGKILL [exp_pid]
wait
forwardOutput "**** '$command' killed ****\n"
startProgram
}
set paranoid 0
set echo 0
set directory .
while {[string match -* $argv]} {
switch -exact -- [lindex $argv 0] {
"-?" - "-help" {
puts "usage: shellbox.tcl \[options\] port command ..."
puts "options: -help : show this text"
puts " -version : show cvs release"
puts " -paranoid : allow connections from localhost only"
puts " -echo : echo input of one client to all others"
exit 0
}
"-?" - "-help" { usage; exit 0 }
"-v" - "-version" {puts $version; exit 0}
"-paranoid" {set paranoid 1}
"-echo" {set echo 1}
default {puts stderr "unknown option [lindex $argv 0]"; exit 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]
}
@@ -190,8 +198,7 @@ while {[string match -* $argv]} {
set port [lindex $argv 0]
set command [lrange $argv 1 end]
if {![regexp {^[0-9]+$} $port] || [llength $command] == 0} {
puts stderr "usage: [file tail $argv0] \[-paranoid\] <port> <command> \[args\]"
exit 1
usage; exit 1
}
fconfigure stdout -buffering none