496 lines
12 KiB
Tcl
496 lines
12 KiB
Tcl
#---------------------------------------------------------------------------
|
|
# seaman scripts (connection bookkeeping)
|
|
#---------------------------------------------------------------------------
|
|
|
|
proc check_instrument {caller {hostport {}}} {
|
|
if {[sicsdescriptor $caller] ne "sea"} {
|
|
catch {removeobject $caller}
|
|
catch {removeobject _$caller}
|
|
if {$hostport eq ""} {
|
|
set hostport "$caller:8641"
|
|
}
|
|
stdConfig::make seaclient $caller _$caller -port $hostport
|
|
} elseif {[driverKind _$caller oldhostport] eq "sctcontroller"} {
|
|
if {$oldhostport ne $hostport} {
|
|
_$caller reconnect $hostport
|
|
}
|
|
}
|
|
}
|
|
|
|
proc book_request {caller hostport device args} {
|
|
clientput "$caller ($hostport) wants to get: $args"
|
|
check_instrument $caller $hostport
|
|
|
|
# make a list of already booked items for caller
|
|
foreach item [busy_list items] {
|
|
set ins [result busy_list $item]
|
|
if {$ins eq $caller} {
|
|
set booked($item) 1
|
|
}
|
|
}
|
|
# make a list of requested items from caller
|
|
foreach item [request_list items] {
|
|
set ins [result request_list $item]
|
|
if {$ins eq $caller} {
|
|
set requested($item) 1
|
|
}
|
|
}
|
|
|
|
if {$device eq "PARTIAL"} {
|
|
set all 0
|
|
} else {
|
|
set all 1
|
|
device_list makeitem $caller $device
|
|
}
|
|
# book or add to the list of booked by other instruments
|
|
set cmd [list reconnect_or_set_busy]
|
|
foreach itm $args {
|
|
if {[string match "sample-ts*" $itm] || [string match "localhost*"] $itm} {
|
|
set item "${caller}/$itm"
|
|
} else {
|
|
set item $itm
|
|
}
|
|
if {[busy_list exists $item]} {
|
|
set ins [result busy_list $item]
|
|
set booked($item) 0
|
|
if {$ins ne $caller} {
|
|
request_list makeitem $item $caller
|
|
set requested($item) 0
|
|
}
|
|
} else {
|
|
busy_list_add $item $caller
|
|
set booked($item) 0
|
|
set ins $caller
|
|
}
|
|
if {$all && $ins eq $caller} {
|
|
set arg [list $itm]
|
|
} else {
|
|
set arg [list $itm $ins [silent "" result device_list $ins]]
|
|
}
|
|
lappend cmd $arg
|
|
}
|
|
|
|
array set confirm_list {}
|
|
if {$all} {
|
|
# remove not requested bookings of caller
|
|
set items ""
|
|
foreach item [array names booked] {
|
|
if {$booked($item)} {
|
|
lappend items $item
|
|
busy_list_add $item KILL
|
|
if {[request_list exists $item]} {
|
|
set ins [result request_list $item]
|
|
clientput "confirm $ins"
|
|
lappend confirm_list($ins) $item
|
|
}
|
|
}
|
|
}
|
|
foreach item [array names requested] {
|
|
if {$requested($item)} {
|
|
request_list deleteitem $item
|
|
}
|
|
}
|
|
if {$items ne ""} {
|
|
clientput "$caller does no longer need: $items"
|
|
}
|
|
}
|
|
$caller / $cmd
|
|
clientput "inform $caller about busy items: [lrange $cmd 1 end]"
|
|
foreach i [array names confirm_list] {
|
|
clientput "confirm_list $i : $confirm_list($i)"
|
|
eval "book_confirm $i $confirm_list($i)"
|
|
}
|
|
return ""
|
|
}
|
|
|
|
proc busy_list_add {hostport caller} {
|
|
if {$caller eq "KILL"} {
|
|
busy_list deleteitem $hostport
|
|
} else {
|
|
busy_list makeitem $hostport $caller
|
|
}
|
|
}
|
|
|
|
proc get_instruments {} {
|
|
set ilist [split [unknown list match _*] ","]
|
|
foreach instr $ilist {
|
|
if {$instr ne "ENDLIST"} {
|
|
set ins [string range $instr 1 end]
|
|
if {[sicsdescriptor $ins] eq "sea"} {
|
|
lappend instruments [string range $instr 1 end]
|
|
}
|
|
}
|
|
}
|
|
return $instruments
|
|
}
|
|
|
|
proc hostport_of {ctrl rack} {
|
|
source config/rack.list
|
|
set hostport ""
|
|
array set racks $racklist
|
|
catch {
|
|
set cfglist $racks($rack)
|
|
foreach {obj hostport} $cfglist {
|
|
if {$obj eq $ctrl} {
|
|
break
|
|
}
|
|
}
|
|
}
|
|
return $hostport
|
|
}
|
|
|
|
proc hostports_of {rack} {
|
|
source config/rack.list
|
|
set hostport ""
|
|
array set racks $racklist
|
|
set result [list]
|
|
catch {
|
|
set cfglist $racks($rack)
|
|
foreach {obj hostport} $cfglist {
|
|
lappend result $hostport
|
|
}
|
|
}
|
|
return $result
|
|
}
|
|
|
|
proc rack_owner {rack {owner ""} {used ""}} {
|
|
if {$rack eq "no"} return
|
|
set hostport [hostport_of _cc $rack]
|
|
if {$hostport eq ""} {
|
|
clientput "$rack not found"
|
|
return
|
|
}
|
|
if {$owner eq ""} {
|
|
return [silent undef result rack_list $rack]
|
|
}
|
|
clientlog "rack $rack owner $owner old [silent free result rack_list $rack]"
|
|
if {$owner eq "free"} {
|
|
# if {$hostport ne ""} {
|
|
# dolater 3 rack_reconnect $rack $hostport
|
|
# }
|
|
foreach p [hostports_of $rack] {
|
|
catch {busy_list deleteitem $p}
|
|
}
|
|
rack_list makeitem $rack free
|
|
} else {
|
|
# release all racks attached to owner first
|
|
foreach irack [rack_list items] {
|
|
if {[result rack_list $irack] eq $owner} {
|
|
rack_list $irack free
|
|
}
|
|
}
|
|
# attach rack to owner
|
|
rack_list makeitem $rack $owner
|
|
if {$used ne ""} {
|
|
catch {instr_list $owner $inuse}
|
|
}
|
|
# obsolete after change:
|
|
if {[sicsdescriptor $rack] eq "ccu4"} {
|
|
removeobject $rack
|
|
if {[sicsdescriptor _$rack] eq "SctController"} {
|
|
removeobject _$rack
|
|
}
|
|
clientput "release $rack"
|
|
}
|
|
}
|
|
}
|
|
|
|
# obsolete:
|
|
proc rack_reconnect {rack hostport} {
|
|
if {[sicsdescriptor $rack] eq "notfound"} {
|
|
stdConfig::make -driver ccu4 -name $rack -port $hostport
|
|
} else {
|
|
_$rack reconnect
|
|
}
|
|
clientput "reconnect $rack"
|
|
rack_list makeitem $rack free
|
|
}
|
|
|
|
proc rack_in_use_on {rack instrument inuse} {
|
|
global free_instr_cache
|
|
|
|
instr_list makeitem $instrument $inuse
|
|
if {$inuse} {
|
|
if {[silent free result rack_list $rack] ne $instrument} {
|
|
rack_owner $rack $instrument 1
|
|
}
|
|
}
|
|
catch {unset free_instr_cache}
|
|
}
|
|
|
|
proc free_instruments {} {
|
|
global free_instr_cache
|
|
|
|
if {![info exists free_instr_cache]} {
|
|
set ilist [instr_list items]
|
|
set fi [list]
|
|
foreach ins $ilist {
|
|
if {[result instr_list $ins] == 0} {
|
|
lappend fi $ins
|
|
}
|
|
}
|
|
set free_instr_cache [join $fi ","]
|
|
}
|
|
return $free_instr_cache
|
|
}
|
|
|
|
proc ask_for_rack {rack instrument} {
|
|
set ins [silent free result rack_list $rack]
|
|
set hins [silent $ins result busy_list [hostport_of _cc $rack]]
|
|
if {$hins ne $ins} {
|
|
$instrument / rack_not_available $rack $hins
|
|
return
|
|
}
|
|
clientlog "$rack: $ins -> $instrument"
|
|
if {$ins eq $instrument} {
|
|
$instrument / install_rack $rack
|
|
return
|
|
}
|
|
if {$ins eq "free"} {
|
|
dolater 1 rack_available_for $rack $instrument
|
|
return
|
|
}
|
|
clientlog $ins / release_rack_for $rack $instrument
|
|
$ins / release_rack_for $rack $instrument
|
|
}
|
|
|
|
proc move_rack_to {rack to} {
|
|
if {$rack eq "no"} return
|
|
if {$to eq "free"} {
|
|
rack_owner $rack $to
|
|
return
|
|
}
|
|
dolater 0 rack_available_for $rack $to
|
|
}
|
|
|
|
proc rack_available_for {rack instrument {tmo now}} {
|
|
if {$tmo eq "force" || [silent 0 result rack_list $rack] eq "free"} {
|
|
clientlog "- $instrument / install_rack $rack"
|
|
dolater 3 $instrument / install_rack $rack
|
|
return
|
|
}
|
|
set now [DoubleTime]
|
|
if {$tmo eq "now"} {
|
|
set tmo $now
|
|
}
|
|
if {$tmo <= $now + 30} {
|
|
error "timeout in rack_available_for $rack $instrument"
|
|
}
|
|
dolater 1 rack_available_for $rack $instrument $tmo
|
|
}
|
|
|
|
proc rack_not_available_for {rack instrument old} {
|
|
clientlog $instrument / rack_not_available $rack $old
|
|
$instrument / rack_not_available $rack $old
|
|
}
|
|
|
|
proc book_this {caller args} {
|
|
clientput "$caller wants to disconnect: $args"
|
|
foreach {item instr} $args {
|
|
if {[result busy_list $item] eq $instr} {
|
|
lappend ilist($instr) $item
|
|
}
|
|
}
|
|
foreach instr [array names ilist] {
|
|
$instr / disconnect_from $caller $ilist($instr)
|
|
}
|
|
}
|
|
|
|
proc book_confirm {caller args} {
|
|
clientput "inform $caller about disconnected items: $args"
|
|
set rlist ""
|
|
foreach item $args {
|
|
if {[silent "" result request_list $item] eq $caller} {
|
|
request_list deleteitem $item
|
|
}
|
|
busy_list_add $item $caller
|
|
lappend rlist [list $item $caller [silent "" result device_list $caller]]
|
|
}
|
|
$caller / reconnect_or_set_busy $rlist
|
|
}
|
|
|
|
proc show_item {item} {
|
|
set req [silent "" result request_list $item]
|
|
if {$req ne ""} {
|
|
set item [format "%-15s %s" $item $req]
|
|
}
|
|
return [format "%45s %s\n" " " $item]
|
|
}
|
|
|
|
proc device_none_on {instrument} {
|
|
$instrument / samenv -q none
|
|
}
|
|
|
|
proc show {{key ""}} {
|
|
|
|
set ilist [split [unknown list match _*] ","]
|
|
foreach instr $ilist {
|
|
if {$instr ne "ENDLIST"} {
|
|
set ins [string range $instr 1 end]
|
|
if {[sicsdescriptor $ins] eq "sea"} {
|
|
set hostport {}
|
|
driverKind $instr hostport
|
|
# clientlog "$instr $hostport"
|
|
set table($ins) [list $hostport]
|
|
}
|
|
}
|
|
}
|
|
|
|
foreach item [result busy_list items] {
|
|
set ins [result busy_list $item]
|
|
if {![info exists table($ins)]} {
|
|
set table($ins) "?"
|
|
}
|
|
lappend table($ins) $item
|
|
}
|
|
|
|
set result "Instrument Device Connections Requests\n"
|
|
append result "----------------------------------------------------------------------\n"
|
|
foreach instr [lsort [array names table]] {
|
|
set row $table($instr)
|
|
set head [format "%-29s %s\n" "$instr ([lindex $row 0])" [silent "" result device_list $instr]]
|
|
if {$key eq "" || $key eq $instr} {
|
|
append result $head
|
|
foreach item [lrange $row 1 end] {
|
|
append result [show_item $item]
|
|
}
|
|
append result "\n"
|
|
} elseif {[string match "*$key*" [join $row]]} {
|
|
append result $head
|
|
foreach item [lrange $row 1 end] {
|
|
if {[string match "*$key*" $item]} {
|
|
append result [show_item $item]
|
|
}
|
|
}
|
|
append result "\n"
|
|
}
|
|
}
|
|
return $result
|
|
}
|
|
|
|
proc get_devices {args} {
|
|
set ilist [split $args ","]
|
|
set result [list]
|
|
foreach ins $ilist {
|
|
set dev [silent {} result samenv_list $ins]
|
|
if {$dev eq ""} {
|
|
set dev [silent {} result device_list $ins]
|
|
}
|
|
lappend result $dev
|
|
}
|
|
return [join $result ","]
|
|
}
|
|
|
|
proc samenv args {
|
|
if {$args eq "name"} {
|
|
return "_inst_select"
|
|
}
|
|
if {[llength $args] > 0} {
|
|
error "forbidden on seaman"
|
|
}
|
|
}
|
|
|
|
namespace eval inst_select {
|
|
|
|
clientput "REORDER web_ports"
|
|
|
|
set home /home/l_samenv
|
|
|
|
foreach itm [web_ports items] {
|
|
web_ports deleteitem $itm
|
|
}
|
|
|
|
proc instrument {instr} {
|
|
}
|
|
|
|
proc seaweb {instr port {host ""}} {
|
|
web_ports makeitem $instr $port
|
|
}
|
|
|
|
proc sea {mode sea graph web} {
|
|
}
|
|
|
|
proc schedule_cron args {}
|
|
proc writeServer args {}
|
|
|
|
set mrc stdout
|
|
source ../../monitconfig
|
|
|
|
web_ports makeitem test TEST
|
|
samenv_list makeitem test instrlist
|
|
device_list makeitem test instrlist
|
|
}
|
|
|
|
proc _inst_selectGroup {} {
|
|
foreach instr [web_ports items] {
|
|
set dev [silent "" result samenv_list $instr]
|
|
set dev1 [silent "" result device_list $instr]
|
|
if {$dev eq "" || $dev1 ne [lindex [split $dev /] 0]} {
|
|
set dev $dev1
|
|
}
|
|
if {$dev ne ""} {
|
|
clientput -T[string toupper $instr]
|
|
clientput -V$dev
|
|
set link [result web_ports $instr]
|
|
if {$link eq "TEST"} {
|
|
clientput -l:8000/?sg=1&sm=0&sc=0
|
|
clientput -i_link_test
|
|
} else {
|
|
clientput -l:[result web_ports $instr]
|
|
clientput -i_link_[result web_ports $instr]
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
proc getgroup_inst_select {} {
|
|
Group _inst_select " "
|
|
}
|
|
|
|
proc rackGroup {} {
|
|
foreach rack [lsort [rack_list items]] {
|
|
Input "$rack attached to" "rack_owner $rack"
|
|
}
|
|
}
|
|
|
|
proc portsGroup {} {
|
|
foreach port [lsort [busy_list items]] {
|
|
Input "$port attached to" "busy_list $port"
|
|
}
|
|
}
|
|
|
|
proc mainGroup {} {
|
|
Group rack "racks"
|
|
Group ports "ports"
|
|
}
|
|
|
|
proc refresh {} {
|
|
foreach instr [instr_list items] {
|
|
clientlog "$instr"
|
|
catch {
|
|
$instr / save_samenv
|
|
} msg
|
|
clientput $msg
|
|
}
|
|
}
|
|
|
|
|
|
publish book_this User
|
|
publish book_request User
|
|
publish book_confirm User
|
|
publish device_none_on User
|
|
publish get_devices User
|
|
publish show Spy
|
|
publish update_rack_list Spy
|
|
publish get_instruments Spy
|
|
publish rack_owner Spy
|
|
publish rack_in_use_on Spy
|
|
|
|
publish ask_for_rack Spy
|
|
publish rack_available_for Spy
|
|
publish rack_not_available_for Spy
|
|
publish free_instruments Spy
|
|
publish move_rack_to Spy
|
|
|
|
publish refresh Spy
|