455 lines
13 KiB
Tcl
Executable File
455 lines
13 KiB
Tcl
Executable File
#!/usr/bin/tclsh
|
|
#-------------------------------------------------------------------------
|
|
# This program tests the communication to the various devices
|
|
# belonging to an instrument. For this to work, the SICServer
|
|
# and all accociated process have to be off: monit stop all.
|
|
#
|
|
# Mark Koennecke, November 2006
|
|
#------------------------------------------------------------------------
|
|
set debug 0
|
|
#-----------------------------------------------------------------------
|
|
proc pingTest {host} {
|
|
set status [catch {exec ping -c 5 $host} msg]
|
|
if {$status == 0} {
|
|
return OK
|
|
} else {
|
|
error "Ping failed for $host"
|
|
}
|
|
}
|
|
#----------------------------------------------------------------------
|
|
proc readReply {chan} {
|
|
global replyData
|
|
gets $chan replyData
|
|
}
|
|
#----------------------------------------------------------------------
|
|
proc timeout {} {
|
|
global replyData
|
|
set replyData TIMEOUT
|
|
}
|
|
#-----------------------------------------------------------------------
|
|
proc sendCommand {chan command} {
|
|
global replyData debug
|
|
puts -nonewline $chan $command
|
|
flush $chan
|
|
if {$debug == 1} {
|
|
puts stdout "Sent $command"
|
|
}
|
|
after 300
|
|
after 20000 timeout
|
|
vwait replyData
|
|
if {$debug == 1} {
|
|
puts stdout "Received $replyData"
|
|
}
|
|
return $replyData
|
|
}
|
|
#-----------------------------------------------------------------------
|
|
proc makeConnection {host port} {
|
|
set socke [socket $host $port]
|
|
fconfigure $socke -blocking 0
|
|
fileevent $socke readable [list readReply $socke]
|
|
return $socke
|
|
}
|
|
#-----------------------------------------------------------------------
|
|
proc makeJuelichConnection {host port} {
|
|
set socke [socket $host $port]
|
|
fconfigure $socke -blocking 0 -encoding binary
|
|
return $socke
|
|
}
|
|
#------------------------------------------------------------------------
|
|
proc testEL737 {host port} {
|
|
puts stdout "Testing for EL737 counter at $host $port"
|
|
if {[catch {pingTest $host} msg] != 0} {
|
|
error $msg
|
|
}
|
|
set socke [makeConnection $host $port]
|
|
sendCommand $socke "RMT 1\r"
|
|
sendCommand $socke "ECHO 0\r"
|
|
sendCommand $socke "RMT 1\r"
|
|
sendCommand $socke "ECHO 0\r"
|
|
for {set i 0} {$i < 3} {incr i} {
|
|
set replyData [sendCommand $socke "ID\r"]
|
|
if {[string first EL737 $replyData] >= 0} {
|
|
close $socke
|
|
return OK
|
|
}
|
|
}
|
|
close $socke
|
|
error "Bad reply $replyData from EL737"
|
|
}
|
|
#-------------------------------------------------------------------------
|
|
proc testEL734 {host port} {
|
|
puts stdout "Testing for EL734 motor controller at $host $port"
|
|
if {[catch {pingTest $host} msg] != 0} {
|
|
error $msg
|
|
}
|
|
set socke [makeConnection $host $port]
|
|
sendCommand $socke "RMT 1\r"
|
|
sendCommand $socke "ECHO 0\r"
|
|
sendCommand $socke "RMT 1\r"
|
|
sendCommand $socke "ECHO 0\r"
|
|
for {set i 0} {$i < 10} {incr i} {
|
|
set replyData [sendCommand $socke "ID\r"]
|
|
if {[string first EL734 $replyData] >= 0} {
|
|
close $socke
|
|
return OK
|
|
}
|
|
}
|
|
close $socke
|
|
error "Bad reply $replyData from EL734"
|
|
}
|
|
#------------------------------------------------------------------------
|
|
proc testSPS {host port} {
|
|
puts stdout "Testing SPS at $host $port"
|
|
set socke [makeConnection $host $port]
|
|
set reply [sendCommand $socke "R\r\n"]
|
|
close $socke
|
|
if {![regexp {R [0-9]{3} [0-9]{3} [0-9]{3}} $reply]} {
|
|
error "Bad reply $reply from SPS"
|
|
}
|
|
return OK
|
|
}
|
|
#------------------------------------------------------------------------
|
|
proc testVelo {host port} {
|
|
global debug
|
|
puts stdout "Testing velocity selector at $host, $port"
|
|
set socke [socket $host $port]
|
|
fconfigure $socke -blocking 0
|
|
puts $socke "???\r\n"
|
|
flush $socke
|
|
set count 0
|
|
for {set i 0} {$i < 20} {incr i} {
|
|
after 1000
|
|
set txt [gets $socke]
|
|
if {[string length $txt] > 5} {
|
|
set reply($count) $txt
|
|
incr count
|
|
}
|
|
}
|
|
close $socke
|
|
if {$count < 1} {
|
|
error "No reply from velocity selector"
|
|
}
|
|
if {[string first Status $reply(0)] < 0} {
|
|
error "Bad velocity selector reply: $reply(0)"
|
|
}
|
|
if {[string first S_DREH $reply(0)] < 0} {
|
|
error "Bad velocity selector reply: $reply(0)"
|
|
}
|
|
if {[string first I_DREH $reply(0)] < 0} {
|
|
error "Bad velocity selector reply: $reply(0)"
|
|
}
|
|
if {$debug == 1} {
|
|
puts stdout "$count lines received from chopper"
|
|
for {set i 0} {$i < $count} {incr i} {
|
|
puts stdout $reply($i)
|
|
}
|
|
}
|
|
return OK
|
|
}
|
|
#------------------------------------------------------------------------
|
|
proc testChopper {host port} {
|
|
global debug
|
|
puts stdout "Testing Dornier Chopper at $host, $port"
|
|
set socke [socket $host $port]
|
|
fconfigure $socke -blocking 0
|
|
puts $socke "asyst 1\r\n"
|
|
flush $socke
|
|
set count 0
|
|
for {set i 0} {$i < 20} {incr i} {
|
|
after 1000
|
|
set txt [gets $socke]
|
|
if {[string length $txt] > 5} {
|
|
set reply($count) $txt
|
|
incr count
|
|
}
|
|
}
|
|
close $socke
|
|
if {$count < 2} {
|
|
error "No or insufficient response from chopper"
|
|
}
|
|
if {[string first asyst $reply(0)] < 0} {
|
|
error "Bad reply from chopper: $reply(0)"
|
|
}
|
|
if {[string first "..valid" $reply(0)] < 0} {
|
|
error "Bad reply from chopper: $reply(0)"
|
|
}
|
|
if {[string first "chopp_1" $reply(1)] < 0} {
|
|
error "Bad reply from chopper: $reply(1)"
|
|
}
|
|
if {$debug == 1} {
|
|
puts stdout "$count lines received from chopper"
|
|
for {set i 0} {$i < $count} {incr i} {
|
|
puts stdout $reply($i)
|
|
}
|
|
}
|
|
return OK
|
|
}
|
|
#----------------------------------------------------------------------
|
|
proc juelichCheckSum {txt} {
|
|
set checkSum 0
|
|
for {set i 1} {$i < [string length $txt]} {incr i} {
|
|
set c [scan [string index $txt $i] %c]
|
|
set checkSum [expr $checkSum + $c]
|
|
}
|
|
return $checkSum
|
|
}
|
|
#------------------------------------------------------------------------
|
|
proc testJuelich {host port} {
|
|
puts stdout "Testing Juelich Choppers at $host $port"
|
|
set ans "None"
|
|
set checksum [juelichCheckSum "#RAS"]
|
|
set command [format "#RAS{%d}$" $checksum]
|
|
set sock [makeJuelichConnection $host $port]
|
|
puts -nonewline $sock $command
|
|
flush $sock
|
|
for {set i 0} {$i < 3} {incr i} {
|
|
after 1000
|
|
set ans [read $sock 120]
|
|
puts stdout $ans
|
|
set stat [catch { \
|
|
scan $ans "#RAS:%d:%d:%d:%d:%d{%d}" c1 c2 c3 c4 c5 check} num]
|
|
if {$stat == 0} {
|
|
if {$num == 6} {
|
|
close $sock
|
|
return OK
|
|
}
|
|
}
|
|
}
|
|
close $sock
|
|
return "ERROR: did not get reply from Juelich, possibles ans: $ans"
|
|
}
|
|
#------------------------------------------------------------------------
|
|
proc testEmmenegger {host port} {
|
|
puts stdout "Testing Emmenegger electronic at $host, $port"
|
|
set sock [makeConnection $host $port]
|
|
sendCommand $sock "D\r"
|
|
set rep [sendCommand $sock "D\r"]
|
|
close $sock
|
|
if {![string is double $rep]} {
|
|
error "Unexpected reply $rep from Emmenegger"
|
|
}
|
|
return OK
|
|
}
|
|
#------------------------------------------------------------------------
|
|
proc testMDIF {host port} {
|
|
puts stdout "Testing MDIF at $host, $port"
|
|
set sock [makeConnection $host $port]
|
|
set rep [sendCommand $sock "TD\r"]
|
|
close $sock
|
|
if {[string first TD $rep] < 0} {
|
|
error "Unexpected reply $rep from MDIF"
|
|
}
|
|
return 0K
|
|
}
|
|
#-------------------------------------------------------------------------
|
|
proc testHM {host} {
|
|
if {[catch {pingTest $host} msg] != 0} {
|
|
error $msg
|
|
}
|
|
set status [catch {exec sinqhm_ctrl -host $host status} msg]
|
|
if {$status != 0} {
|
|
error "HM $host failed with $msg"
|
|
}
|
|
set idx [string first Histogramming $msg]
|
|
set idx2 [string first acquisition $msg]
|
|
set idx3 [string first SinqHM $msg]
|
|
if {$idx < 0 || $idx2 < 0 || $idx3 < 0} {
|
|
puts stdout $msg
|
|
error "Message does not seem to come from SinqHM"
|
|
}
|
|
return OK
|
|
}
|
|
#------------------------------------------------------------------------
|
|
proc testHttpHM {host} {
|
|
puts stdout "Testing Http-HM at $host"
|
|
if {[catch {pingTest $host} msg] != 0} {
|
|
error $msg
|
|
}
|
|
catch \
|
|
{exec wget --user=spy --password=007 \
|
|
http://$host/admin/status.egi >& wget.lis}
|
|
set in [open wget.lis r]
|
|
while {[gets $in line] >= 0} {
|
|
append msg $line "\n"
|
|
}
|
|
close $in
|
|
set idx [string first 200 $msg]
|
|
set idx2 [string first OK $msg]
|
|
set idx3 [string first status.egi $msg]
|
|
if {$idx < 0 || $idx2 < 0 || $idx3 < 0} {
|
|
puts stdout $msg
|
|
error "Message does not seem to come from Sinq Http HM"
|
|
}
|
|
return OK
|
|
}
|
|
#-----------------------------------------------------------------------
|
|
proc testList {testList} {
|
|
foreach com $testList {
|
|
catch {eval $com} msg
|
|
puts stdout $msg
|
|
}
|
|
}
|
|
#======================= Database Section ===============================
|
|
set ts psts224
|
|
lappend amor [list pingTest amor.psi.ch]
|
|
lappend amor [list testEL734 $ts 3002]
|
|
lappend amor [list testEL734 $ts 3003]
|
|
lappend amor [list testEL734 $ts 3004]
|
|
lappend amor [list testEL737 $ts 3005]
|
|
lappend amor [list testSPS $ts 3006]
|
|
lappend amor [list testEmmenegger $ts 3007]
|
|
lappend amor [list testChopper $ts 3014]
|
|
lappend amor [list testMDIF $ts 3015]
|
|
lappend amor [list testHttpHM lnse10]
|
|
|
|
set ts psts225
|
|
lappend dmc [list pingTest dmc.psi.ch]
|
|
lappend dmc [list testEL734 $ts 3002]
|
|
lappend dmc [list testEL737 $ts 3006]
|
|
lappend dmc [list testHM lnse01]
|
|
|
|
set ts psts227
|
|
lappend focus [list pingTest focus.psi.ch]
|
|
lappend focus [list testEL734 $ts 3002]
|
|
lappend focus [list testEL734 $ts 3003]
|
|
lappend focus [list testSPS $ts 3004]
|
|
lappend focus [list testEL737 $ts 3005]
|
|
lappend focus [list testEmmenegger $ts 3006]
|
|
lappend focus [list testChopper $ts 3008]
|
|
lappend focus [list testHM lnse04]
|
|
lappend focus [list testHM lnse05.vme]
|
|
lappend focus [list testHM lnse06.vme]
|
|
# Missing 2D detector and MDIF
|
|
|
|
set ts psts229
|
|
lappend hrpt [list pingTest hrpt.psi.ch]
|
|
lappend hrpt [list testEL734 $ts 3002]
|
|
lappend hrpt [list testEL734 $ts 3003]
|
|
lappend hrpt [list testEL734 $ts 3004]
|
|
lappend hrpt [list testEL734 $ts 3005]
|
|
lappend hrpt [list testEL737 $ts 3006]
|
|
lappend hrpt [list testSPS $ts 3008]
|
|
lappend hrpt [list testHM lnse03]
|
|
|
|
set ts psts235
|
|
lappend mars [list pingTest mars.psi.ch]
|
|
lappend mars [list testEL734 $ts 3002]
|
|
lappend mars [list testEL734 $ts 3003]
|
|
lappend mars [list testEL734 $ts 3004]
|
|
lappend mars [list testEL734 $ts 3005]
|
|
lappend mars [list testEL734 $ts 3006]
|
|
lappend mars [list testEL734 $ts 3007]
|
|
lappend mars [list testEL737 $ts 3008]
|
|
lappend mars [list testJuelich $ts 3009]
|
|
lappend mars [list testMDIF $ts 3010]
|
|
lappend mars [list testHttpHM lnse13]
|
|
|
|
set ts lnsts06
|
|
lappend morpheus [list pingTest morpheus.psi.ch]
|
|
lappend morpheus [list testEL734 $ts 3002]
|
|
lappend morpheus [list testEL734 $ts 3003]
|
|
lappend morpheus [list testEL734 $ts 3004]
|
|
lappend morpheus [list testEL737 $ts 3005]
|
|
lappend morpheus [list testSPS $ts 3006]
|
|
|
|
set ts psts230
|
|
#stimmt das noch? Ist da nicht dieser moxa drinne?
|
|
lappend narziss [list pingTest narziss.psi.ch]
|
|
lappend narziss [list testEL734 $ts 3002]
|
|
lappend narziss [list testEL737 $ts 3003]
|
|
|
|
|
|
set ts psts240
|
|
lappend poldi [list pingTest poldi.psi.ch]
|
|
lappend poldi [list testEL734 $ts 3002]
|
|
lappend poldi [list testEL734 $ts 3003]
|
|
lappend poldi [list testEL737 $ts 3004]
|
|
lappend poldi [list testChopper $ts 3005]
|
|
lappend poldi [list testHM lnse11]
|
|
#------ missing TIWI electronic
|
|
|
|
set ts lnsts02
|
|
lappend rita2 [list pingTest rita2.psi.ch]
|
|
lappend rita2 [list pingTest lnsgpib01.psi.ch]
|
|
lappend rita2 [list testEL734 $ts 3002]
|
|
lappend rita2 [list testEL737 $ts 3005]
|
|
#-------- can GPIB communication more sensibly be tested???
|
|
|
|
set ts psts223
|
|
lappend sans [list pingTest sans.psi.ch]
|
|
lappend sans [list testEL734 $ts 3002]
|
|
lappend sans [list testEL734 $ts 3003]
|
|
lappend sans [list testEL734 $ts 3016]
|
|
lappend sans [list testEL737 $ts 3004]
|
|
lappend sans [list testVelo $ts 3006]
|
|
lappend sans [list testSPS $ts 3009]
|
|
lappend sans [list testSPS $ts 3010]
|
|
#---------- another count of TIWI
|
|
|
|
set ts psts234
|
|
lappend sansli [list pingTest sans2.psi.ch]
|
|
lappend sansli [list testEL734 $ts 3002]
|
|
lappend sansli [list testEL734 $ts 3003]
|
|
lappend sansli [list testVelo $ts 3004]
|
|
lappend sansli [list testEL737 $ts 3009]
|
|
|
|
set ts psts231
|
|
lappend tasp [list pingTest tasp.psi.ch]
|
|
lappend tasp [list testEL734 $ts 3002]
|
|
lappend tasp [list testEL734 $ts 3003]
|
|
lappend tasp [list testEL737 $ts 3004]
|
|
|
|
set ts lnsts05
|
|
lappend trics [list pingTest trics.psi.ch]
|
|
lappend trics [list testEL734 $ts 3002]
|
|
lappend trics [list testEL734 $ts 3003]
|
|
lappend trics [list testEL734 $ts 3004]
|
|
lappend trics [list testEL734 $ts 3005]
|
|
lappend trics [list testEL734 $ts 3006]
|
|
lappend trics [list testEL737 $ts 3007]
|
|
lappend trics [list testHM lnse07]
|
|
lappend trics [list testHM lnse08]
|
|
lappend trics [list testHM lnse09]
|
|
|
|
#--------------------------------------------------------
|
|
proc exitus {no} {
|
|
exit $no
|
|
}
|
|
#-------------------------------------------------------
|
|
proc testInstrument {inst} {
|
|
global amor dmc focus hrpt mars narziss poldi rita2
|
|
global sans sansli tasp trics
|
|
switch $inst {
|
|
amor {testList $amor}
|
|
dmc {testList $dmc}
|
|
focus {testList $focus}
|
|
hrpt {testList $hrpt}
|
|
mars {testList $mars}
|
|
morpheus {testList $morpheus}
|
|
narziss {testList $narziss}
|
|
poldi {testList $poldi}
|
|
rita2 {testList $rita2}
|
|
sans {testList $sans}
|
|
sans2 {testList $sansli}
|
|
sansli {testList $sansli}
|
|
tasp {testList $tasp}
|
|
trics {testList $trics}
|
|
default {"Instrument not known"
|
|
exitus 1
|
|
}
|
|
}
|
|
}
|
|
#====================== "main" program ===================
|
|
if {$argc < 1} {
|
|
puts stdout "Usage:\n\tsinqcom instrument"
|
|
exitus 1
|
|
}
|
|
puts stdout "=== This program will fail if SICS ist still running! ==="
|
|
puts stdout "=== This program will also fail if not run from a ==="
|
|
puts stdout "=== computer within the SINQ subnet ==="
|
|
|
|
testInstrument [lindex $argv 0]
|
|
|
|
puts stdout "Done"
|
|
exitus 0
|