initial commit

tcl/startup/rack.tcl

@@ -0,0 +1,67 @@
+proc get_ip {host} {
+  lassign [split $host .] host
+  set host $host.psi.ch
+  # clientlog HOST:$host
+  set ip [exec dig $host +short]
+  # clientlog IP:$ip
+  return $ip
+}
+
+proc get_subnet {ip} {
+  if {[string match {129.129.*} $ip]} {
+    set subnet office
+  } else {
+    set instip [lrange [split $ip .] 0 2]
+    # instrument computer ip ends with 60
+    lappend instip 60
+    lassign [split [exec dig -x [join $instip .] +short] .] subnet
+  }
+  return $subnet
+}
+
+proc get_rack {{oldrack ""}} {
+  source config/rack.list
+  set mysubnet [get_subnet [get_ip [info hostname]]]
+  if {$oldrack ne ""} {
+    array set racks $racklist
+    if {[catch {
+      set racklist [list]
+      lappend racklist $oldrack $racks($oldrack)
+    }]} {
+      return "$oldrack is not in ~/sea/tcl/config/rack.list"
+    }
+  }
+  set found [list]
+  set inmynet [list]
+  foreach {rack rack_cfg} $racklist {
+    array set cfg_array $rack_cfg
+    if {[catch {
+      lassign [split $cfg_array(_cc) :] host
+    } msg]} {
+      return "$oldrack has no ccu configured $msg $rack_cfg"
+    } 
+    if {$host ne "unconnected"} {
+      set ip [get_ip $host]
+      if {$ip eq ""} {
+        if {$rack eq $oldrack} {
+          return "$rack not reachable"
+        }
+      } else {
+        set subnet [get_subnet $ip]
+        if {$mysubnet eq $subnet} {
+          lappend found $rack
+          lappend inmynet $rack
+        } elseif {$subnet eq "office"} {
+          lappend found $rack
+        } elseif {$rack eq $oldrack} {
+          return "$rack at $subnet net is not accessible from $mysubnet net"
+        }
+      }
+    }
+  }
+  if {$mysubnet ne "office" && [llength $inmynet]} {
+    # if any rack is in the instrument subnet, racks in office net are not shown
+    return $inmynet
+  }
+  return $found
+}