sics/tcl/client.tcl

#!/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