diff --git a/site_ansto/instrument/config/hmm/hmm_configuration_common_1.tcl b/site_ansto/instrument/config/hmm/hmm_configuration_common_1.tcl index b263f300..3068663e 100644 --- a/site_ansto/instrument/config/hmm/hmm_configuration_common_1.tcl +++ b/site_ansto/instrument/config/hmm/hmm_configuration_common_1.tcl @@ -12,7 +12,6 @@ # #@see ::histogram_memory::ic_initialize - source $cfPath(hmm)/hmm_object.tcl namespace eval histogram_memory { # Common config variables @@ -1778,6 +1777,68 @@ Publish SAT_TABLE user return -code error "([info level 0]) $message" } } + + # Make controller for histmem textstatus. Used by hmstat proc + set host [dict get $::HISTMEM_HOSTPORT HMMSTAT HOST] + set port [dict get $::HISTMEM_HOSTPORT HMMSTAT PORT] + MakeSctController sct_hmm astvelsel $host:$port + + proc ::histogram_memory::hmstat {args} { + set startIndex -1 + # Try three times to get at least some data following the HTTP header. + # Usually we get all the data but sometimes we just get the header. + for {set i 0} {$i < 3 && $startIndex == -1} {incr i} { + set req "GET /admin/textstatus.egi HTTP/1.1\r\nAuthorization: Basic bWFuYWdlcjphbnN0bw==\r\n" + set textstatus [sct_hmm transact $req] + set lTextStatus [split $textstatus \n] + set startIndex [lsearch -glob $lTextStatus HM-Host*] + } + # Throw away HTTP header + set lTextStatus [lrange $lTextStatus $startIndex end] + + # Create text status array + foreach l $lTextStatus { + if {[string length $l] == 0} { + continue + } + set v [split $l ':'] + set key [lindex $v 0] + set val [lindex $v 1 0] + if [string is double $val] { + set hmarr($key) $val + } else { + set hmarr($key) '$val' + } + } + + # Return requested values to user + set argc [llength $args] + switch $argc { + 0 { + set keys [array names hmarr] + foreach k [lrange $keys 0 end-1] { + lappend d "'$k': $hmarr($k)," + } + set k [lindex $keys end] + lappend d "'$k': $hmarr($k)" + return [join $d] + } + 1 { + return $hmarr($args) + } + default { + foreach k [lrange $args 0 end-1] { + lappend d "'$k': $hmarr($k)," + } + set k [lindex $args end] + lappend d "'$k': $hmarr($k)" + return [join $d] + } + } + } + # Poll to keep HTTP connection alive + sicspoll add ::histogram_memory::hmstat script 30 ::histogram_memory::hmstat + namespace eval ::histogram_memory { #TODO Create GumTree commands to setup, start and stop the histmem ## @@ -1796,6 +1857,7 @@ namespace eval ::histogram_memory { #command stop_condition {text:immediate,period condition} } + ## # @brief Convenience command providing user interface to histogram control # @@ -1856,6 +1918,9 @@ namespace eval ::histogram_memory { "status" { set reply [::histogram_memory::hmm_status] } + "textstatus" { + set reply [eval "::histogram_memory::hmstat $args"] + } "loadconf" { # Loads configuration tables (OAT, FAT, ...) to histogram server if {$args == ""} { diff --git a/site_ansto/instrument/sans/hostport_config.tcl b/site_ansto/instrument/sans/hostport_config.tcl index 67116c20..cfba8964 100644 --- a/site_ansto/instrument/sans/hostport_config.tcl +++ b/site_ansto/instrument/sans/hostport_config.tcl @@ -22,6 +22,7 @@ foreach {bm host port} { # HISTOGRAM SERVER HOST AND PORT foreach {key host port} { HMM das1-quokka.nbi.ansto.gov.au 8080 + HMSTAT das1-quokka.nbi.ansto.gov.au 8081 } { dict set HISTMEM_HOSTPORT $key HOST $host dict set HISTMEM_HOSTPORT $key PORT $port diff --git a/site_ansto/instrument/sans/hostport_config_test.tcl b/site_ansto/instrument/sans/hostport_config_test.tcl index dd6df555..840ec41c 100644 --- a/site_ansto/instrument/sans/hostport_config_test.tcl +++ b/site_ansto/instrument/sans/hostport_config_test.tcl @@ -24,6 +24,7 @@ foreach {key host port} { # TEST HISTOGRAM SERVER HOST AND PORT foreach {key host port} { HMM das1-test.nbi.ansto.gov.au 8080 + HMMSTAT das1-test.nbi.ansto.gov.au 8081 } { dict set HISTMEM_HOSTPORT $key HOST $host dict set HISTMEM_HOSTPORT $key PORT $port