diff --git a/site_ansto/instrument/util/utility.tcl b/site_ansto/instrument/util/utility.tcl index 8b2de0ee..44d98c91 100644 --- a/site_ansto/instrument/util/utility.tcl +++ b/site_ansto/instrument/util/utility.tcl @@ -1,7 +1,7 @@ # Some useful functions for SICS configuration. -# $Revision: 1.4 $ -# $Date: 2007-07-22 05:23:41 $ +# $Revision: 1.5 $ +# $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 +