initial commit
This commit is contained in:
l_samenv
484
tcl/seamancom.tcl
Normal file
484
tcl/seamancom.tcl
Normal file
@ -0,0 +1,484 @@
|
||||
#---------------------------------------------------------------------------
|
||||
# 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 ","]
|
||||
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 {
|
||||
variable home HOME
|
||||
variable instrument ""
|
||||
|
||||
clientput "REORDER web_ports"
|
||||
|
||||
foreach itm [web_ports items] {
|
||||
web_ports deleteitem $itm
|
||||
}
|
||||
|
||||
proc instrument {instr} {
|
||||
variable instrument
|
||||
set instrument $instr
|
||||
}
|
||||
|
||||
proc seaweb {instr port {host ""}} {
|
||||
web_ports makeitem $instr $port
|
||||
}
|
||||
|
||||
proc sea {mode sea graph web} {
|
||||
variable instrument
|
||||
seaweb $instrument $web
|
||||
}
|
||||
|
||||
proc schedule_cron args {}
|
||||
proc writeServer args {}
|
||||
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"
|
||||
}
|
||||
|
||||
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
|
||||
|
||||
Reference in New Issue
Block a user