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

wait for killed programs to avoid zombies

Browse Source
This commit is contained in:
zimoch
2013-07-11 09:49:48 +00:00
parent e5e3366e75
commit 5c7d1e3140
2 changed files with 77 additions and 51 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ca
+61 -38
View File
@@ -2,12 +2,12 @@
# ca* by Dirk Zimoch
# $Source: /cvs/G/EPICS/App/scripts/ca,v $
# $Date: 2013/04/16 10:12:11 $
# $Date: 2013/07/11 09:49:48 $
regsub -all {\$} {ca* by Dirk Zimoch
$Source: /cvs/G/EPICS/App/scripts/ca,v $
$Revision: 1.24 $
$Date: 2013/04/16 10:12:11 $} {} version
$Revision: 1.25 $
$Date: 2013/07/11 09:49:48 $} {} version
proc printHelp {} {
puts {usage: caget [flags] <channel> [<channel> ...]}
@@ -36,7 +36,7 @@ proc printHelp {} {
puts {-stat always add severity and status}
puts {-nostat never add severity and status}
puts {-hex show integer values as hex}
puts {-num show numeric values instead of strings}
puts {-int show numeric values instead of strings}
puts {-prec <digits> override the PREC field}
puts {-plain don't do any formatting}
puts {-timeout <sec> timeout cawait after <sec> seconds}
@@ -88,29 +88,6 @@ proc formatval {channel {value {}} {sevr {}} {stat {}} {time {}}} {
foreach {attr val} $info($channel) {
set $attr $val
}
catch {
set null 0
if {$TYPE == "DBF_CHAR" && $SIZE > 1 \
&& [lsearch $flags "-num"] == -1 \
&& [lsearch $flags "-int"] == -1 \
&& [lsearch $flags "-hex"] == -1} {
foreach char $VAL {
if {$null && $char != 0} {
error "Not printable"
}
if {($char & 0x7f) >= 0x20 || $char == 0x0a || $char == 0x0d && $char != 0x7f} {
append s [format "%c" $char]
} elseif {$char == 0} {
set null 1
} else {
error "Not prinable"
}
}
set SIZE 1
set TYPE DBF_STRING
set VAL $s
}
}
if {[lsearch $flags -plain] != -1} {
set formatted $VAL
set status ""
@@ -126,6 +103,33 @@ proc formatval {channel {value {}} {sevr {}} {stat {}} {time {}}} {
set sevr $SEVR
set time $TIME
}
if {$TYPE == "DBF_STRING" && [string length $value] == 39} {
puts "reread $channel as $channel$"
set value [pvget $channel$]
}
catch {
set null 0
if {$TYPE == "DBF_CHAR" && $SIZE > 1 \
&& [lsearch $flags "-num"] == -1 \
&& [lsearch $flags "-int"] == -1 \
&& [lsearch $flags "-hex"] == -1} {
foreach char $value {
if {$null && $char != 0} {
error "Not printable"
}
if {($char & 0x7f) >= 0x20 || $char == 0x0a || $char == 0x0d && $char != 0x7f} {
append s [format "%c" $char]
} elseif {$char == 0} {
set null 1
} else {
error "Not prinable"
}
}
set SIZE 1
set TYPE DBF_STRING
set value $s
}
}
if {$SIZE == 1} {
set value [list $value]
}
@@ -153,6 +157,7 @@ proc formatval {channel {value {}} {sevr {}} {stat {}} {time {}}} {
}
}
lappend formatted $val
set EGU ""
}
if {$SIZE > 1} {
set formatted \{[join $formatted]\}
@@ -248,15 +253,6 @@ switch $command {
}
exit $faults
}
"putq" {
foreach {channel setvalue} $argv {
if [catch {pvputq $channel $setvalue} msg] {
puts stderr $msg
incr faults
}
}
exit $faults
}
"gets" {
set channels $argv
foreach channel $argv {
@@ -267,16 +263,43 @@ switch $command {
}
}
}
"putq" -
"put" {
set channels {}
foreach {channel setvalue} $argv {
if [catch {set info($channel) [pvinfo $channel]} msg] {
puts stderr $msg
incr faults
continue
}
foreach {attr value} $info($channel) {
set $attr $value
}
if {$TYPE == "DBF_CHAR" && $SIZE > 1 && \
[lsearch $flags "-int"] == -1 && \
[lsearch $flags "-hex"] == -1} {
set a {}
for {set i 0} {$i < $SIZE} {incr i} {
if {[scan [string index $setvalue $i] "%c" c] == -1} {
set c 0
}
lappend a $c
}
set setvalue $a
}
if [catch {
pvput $channel $setvalue
lappend channels $channel
if {$command == "putq"} {
pvputq $channel $setvalue
} else {
pvput $channel $setvalue
pvget $channel
lappend channels $channel
}
} msg] {
puts stderr $msg
incr faults
}
if {$command == "putq"} { exit $faults }
}
}
"mon" {
shellbox.tcl
+16 -13
View File
@@ -32,8 +32,8 @@ set timeout -1
regsub -all {\$} {shellbox by Dirk Zimoch
$Source: /cvs/G/EPICS/App/scripts/shellbox.tcl,v $
$Revision: 1.9 $
$Date: 2011/03/02 09:21:46 $} {} version
$Revision: 1.10 $
$Date: 2013/07/11 09:49:48 $} {} version
proc usage {} {
puts "usage: shellbox \[options\] port command args"
@@ -70,7 +70,7 @@ 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
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"
@@ -144,22 +144,21 @@ proc startProgram {} {
catch {puts stderr "shellbox: $msg"}
exit 3
}
forwardOutput "**** '$command' started in [pwd] ****\n"
forwardOutput "**** '$command' (pid [exp_pid]) started in [pwd] ****\n"
expect_background {
kill {
"kill" {
killProgram
}
? {
forwardOutput $expect_out(buffer)
}
eof {
puts "EOF received"
forwardOutput "**** '$command' (pid [exp_pid]) sent EOF ****\n"
wait [exp_pid]
if ($diedyoung) {
forwardOutput $expect_out(buffer)
forwardOutput "**** first run of '$command' died within first 10 seconds. I will quit. ****\n"
forwardOutput "**** first run died within first 10 seconds. I will quit. ****\n"
exit 4
}
forwardOutput $expect_out(buffer)
forwardOutput "**** '$command' died ****\n"
after idle startProgram
}
@@ -167,11 +166,15 @@ proc startProgram {} {
}
proc killProgram {} {
global command
forwardOutput "**** killing '$command' ****\n"
exec kill -s SIGKILL [exp_pid]
wait
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