#!/data/koenneck/bin/tclsh #---------------------------------------------------------------------------- # A command line client for SICS, written in plain Tcl. # Just sends and reads commands from the SICServer # # Mark Koennecke, September 1996 #---------------------------------------------------------------------------- #---------- Data section set sdata(test,host) lnsa06.psi.ch set sdata(test,port) 2910 set sdata(dmc,host) lnsa05.psi.ch set sdata(dmc,port) 3006 set sdata(topsi,host) lnsa03.psi.ch set sdata(topsi,port) 9708 set sdata(sans,host) lnsa07.psi.ch set sdata(sans,port) 2915 set sdata(user) Spy set sdata(passwd) 007 set mysocket stdout #-------------------------------------------------------------------------- proc bgerror err { global errorInfo set info $errorInfo puts stdout $err puts stdout "------------------------- StackTrace ---------------------" puts $info } #--------------------------------- procedures section ----------------------- # Setting up the connection to the Server proc StartConnection {host port} { global mysocket global sdata # start main connection set mysocket [socket $host $port] puts $mysocket [format "%s %s" $sdata(user) $sdata(passwd)] set ret [catch {flush $mysocket} msg] if { $ret != 0} { error "Server NOT running!" } fconfigure $mysocket -blocking 0 fconfigure $mysocket -buffering none fileevent $mysocket readable GetData after 5000 } #---------------------------------------------------------------------------- proc GetData { } { global mysocket global b if { [eof $mysocket] } { puts stdout "Connection to server lost" close $mysocket set b 1 return } set buf [read $mysocket] set buf [string trim $buf] set list [split $buf \n] foreach teil $list { set teil [string trimright $teil] puts stdout $teil } puts -nonewline stdout "SICS> " flush stdout } #--------------------------------------------------------------------------- proc SendCommand { text} { global mysocket global b if { [eof $mysocket] } { puts stdout "Connection to server lost" set b 1 } puts $mysocket $text flush $mysocket } #---------------------------------------------------------------------------- proc readProgA {pid} { global readProgADone; global b global mysocket # read outputs of schemdb set tmpbuf [gets $pid]; if {[string first quit $tmpbuf] > -1 } { close $mysocket puts stdout "Closing connection to SICS server on your request..." puts stdout "Bye, bye, have a nice day!" set b 1 } elseif { [string first stop $tmpbuf] > -1} { SendCommand "INT1712 3" } else { SendCommand $tmpbuf } set readProgADone [eof $pid]; if {$readProgADone} { puts "closing..."; catch [close $pid] aa; if {$aa != ""} { puts "HERE1: Error on closing"; exit 1; } } } #-------------------------- some utility functions ------------------------- proc MC { t n } { set string $t for { set i 1 } { $i < $n } { incr i } { set string [format "%s%s" $string $t] } return $string } #------------------------------------------------------------------------- proc PrintHeader { } { global instrument puts stdout [format "%s Welcome to SICS! %s" [MC " " 30] [MC " " 30]] puts stdout [format "%s You are connected to: %s" [MC " " 29] [MC " " 29]] puts stdout [format "%s %s %s" [MC " " 35] $instrument [MC " " 35]] puts stdout "SICS> " flush stdout } #-------------------------------- "MAIN" ----------------------------------- if {$argc < 1} { puts stdout "Usage: client instrumentname" exit 0 } #----------------- StartConnection set instrument [lindex $argv 0] set ret [catch {StartConnection $sdata($instrument,host) \ $sdata($instrument,port)} msg ] if {$ret != 0} { puts stdout $msg exit 1 } #----------------- print header PrintHeader # set the "read" event fileevent stdin readable {readProgA stdin}; #---loop till exit set b 0 vwait b exit 0