Added support to generate SICS port numbers from user ID if SICS is launched from a subdirectory of the user's home.

r2134 | ffr | 2007-08-16 17:13:19 +1000 (Thu, 16 Aug 2007) | 2 lines

site_ansto/instrument/util/utility.tcl

@@ -1,7 +1,7 @@
 # Some useful functions for SICS configuration.
 
-# $Revision: 1.4 $
+# $Revision: 1.5 $
-# $Date: 2007-07-22 05:23:41 $
+# $Date: 2007-08-16 07:13:19 $
 # Author: Ferdi Franceschini (ffr@ansto.gov.au)
 # Last revision by $Author: ffr $
 
@@ -81,7 +81,21 @@ proc set_sicsobj_atts {sobj aklass agroup aname acontrol adata} {
 
 ## TODO put all the utility macros in the utility namespace
 namespace eval utility {
+  variable instrument_names [list echidna wombat kowari quokka platypus pelican taipan]
+  variable sics_port
+  set base_port 60000
+  set currbase $base_port
+  foreach inst $instrument_names {
+    array set sics_port [list\
+      telnet-$inst $currbase\
+      interrupt-$inst [expr {$currbase+1}]\
+      server-$inst [expr {$currbase+2}]\
+      quieck-$inst [expr {$currbase+3}]\
+    ]
+    set currbase [expr {$currbase+100}]
+  }
   namespace export instname;
+  namespace export get_portnum;
   variable instrument_name;
   set instrument_name "";
 
@@ -124,7 +138,7 @@ proc mkData {sobj name aklass args} {
 }
 # Sets the privilege attribute when making a SICS variable
 # access = spy, user, manager, internal, readonly
-  proc mkVar {name type access {along_name x} {anxsave x} {aklass x} {acontrol x} {adata x}} {
+  proc mkVar {name type access {along_name x} {anxsave false} {aklass @none} {acontrol false} {adata false}} {
     array set sicsAccess {spy spy user user manager mugger internal internal readonly internal}
     VarMake $name $type $sicsAccess($access);
     sicslist setatt $name privilege $access; 
@@ -144,12 +158,6 @@ proc mkData {sobj name aklass args} {
   }
 }
 
-namespace import ::utility::*;
-Publish getinfo spy
-Publish setpos user
-Publish SplitReply user
-Publish instname user
-
 proc debug {args} {
   clientput $args
 }
@@ -214,3 +222,52 @@ proc ::utility::hgetplainprop {hpath prop} {
 proc ::utility::hlistplainprop {hpath} {
   return [string trim [join [split [hlistprop $hpath] =] ]]
 }
+
+proc ::utility::GetUID {userName} {
+  set fh [open /etc/passwd r]
+    while {[gets $fh tmpName] != -1} {
+      if {1 == [regexp "^$userName:" $tmpName]} {
+        close $fh
+          return [lindex [split $tmpName :] 2]
+      }
+    }
+  close $fh error "\"$userName\" not found in /etc/passwd"
+}
+
+##\brief Determine if list l1 begins with list l2
+proc lstarts_with {l1 l2} {
+  foreach {e2} $l2 {e1} $l1 {
+    if {$e2 == ""} {return 1}
+    if {$e1 != $e2} {
+      return 0
+    }
+  }
+  return 1
+}
+
+##\brief Useful for converting port names to numbers for configuration parameters.
+#
+#\param port this can either be a port name or number
+#\return always returns the port number
+proc ::utility::get_portnum {port} { 
+  global env tcl_platform
+  variable sics_port 
+  if [string is integer $port] {
+    return $port
+  } else {
+    set home_path_list [split [string trim $env(HOME) /] /]
+    set pwd_path_list [split [string trim $env(PWD) /] /]
+    if [lstarts_with $pwd_path_list $home_path_list] {
+      return [expr $sics_port($port) + [::utility::GetUID $tcl_platform(user)]]
+    } else {
+      return [portnum $port]
+    }
+  }
+}
+
+namespace import ::utility::*;
+Publish getinfo spy
+Publish setpos user
+Publish SplitReply user
+Publish instname user
+