PSI sics-cvs-psi_pre-ansto

tcl/client.tcl

@@ -0,0 +1,151 @@
+#!/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
+