#!/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