tools/tlc_probe

   1 #!/usr/bin/tclsh
   2
   3 # vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4
   4
   5 package require tclreadline
   6
   7 set node                "(node)"
   8 set sock                ""
   9
  10
  11 proc connect {ip port} { #<<<
  12         if {$::sock != ""} {
  13                 catch {close $::sock}
  14                 set ::sock      ""
  15                 set ::node      "(none)"
  16         }
  17         if {[catch {
  18                 set ::sock      [socket $ip $port]
  19         } msg]} {
  20                 puts "Error connecting to $ip:$port: $msg"
  21                 return
  22         }
  23         fconfigure $::sock -blocking 1 -translation binary -encoding binary
  24         set ::node              "$ip:$port"
  25         set ::last_ip   $ip
  26         set ::last_port $port
  27 }
  28 #>>>
  29
  30 # Initial connection <<<
  31 set ip                  ""
  32 if {[llength $argv] != 0} {
  33         set addr                [lindex $argv 0]
  34         set tmp                 [split $addr :]
  35         switch -- [llength $tmp] {
  36                 1 {
  37                         set ip          [lindex $addr 0]
  38                         set port        "5308"
  39                 }
  40                 2 {
  41                         foreach {ip port} $tmp break
  42                 }
  43                 default {
  44                         puts stderr "Syntax: $argv0 \[ip\[:port\]\]"
  45                         exit -1
  46                 }
  47         }
  48 }
  49
  50 if {$ip != ""} {
  51         connect $ip $port
  52 }
  53 #>>>
  54
  55 array set builtins {
  56         "quit"          "Exits the probe console"
  57         "bye"           "Exits the probe console"
  58         "exit"          "Exits the probe console"
  59         "help"          "Displays builtin command help"
  60         "connect"       "Connects to node"
  61 }
  62
  63 proc process_builtin {cmd} { #<<<
  64         switch -- [lindex $cmd 0] {
  65                 "exit" -
  66                 "bye" -
  67                 "quit"  {exit 0}
  68
  69                 "help"  { #<<<
  70                         if {[llength $cmd] == 1} {
  71                                 foreach {key val} [array get ::builtins] {
  72                                         puts "$key:\t$val"
  73                                 }
  74                         } else {
  75                                 set term        [lindex $cmd 1]
  76                                 if {[info exists ::builtins($term)]} {
  77                                         puts $::builtins($term)
  78                                 } else {
  79                                         puts "No such command"
  80                                 }
  81                         }
  82                         #>>>
  83                 }
  84
  85                 "connect" { #<<<
  86                         set addr        [lindex $cmd 1]
  87                         set tmp         [split $addr :]
  88                         switch -- [llength $tmp] {
  89                                 0 {
  90                                         if {[info exists ::last_ip] && [info exists ::last_port]} {
  91                                                 set ip          $::last_ip
  92                                                 set port        $::last_port
  93                                         } else {
  94                                                 puts "Syntax: connect ip\[:port\]"
  95                                                 return
  96                                         }
  97                                 }
  98                                 1 {
  99                                         set ip          [lindex $tmp 0]
 100                                         set port        "5308"
 101                                 }
 102                                 2 {
 103                                         foreach {ip port} $tmp break
 104                                 }
 105                                 default {
 106                                         puts "Syntax: connect ip\[:port\]"
 107                                         return
 108                                 }
 109                         }
 110                         connect $ip $port
 111                         #>>>
 112                 }
 113
 114                 default { #<<<
 115                         puts "Command not implemented yet"
 116                         #>>>
 117                 }
 118         }
 119 }
 120 #>>>
 121
 122 proc sendcmd {cmd} { #<<<
 123         if {$::sock == ""} {
 124                 puts "Not connected to a node"
 125                 return
 126         }
 127
 128         puts $::sock [string length $cmd]
 129         puts -nonewline $::sock $cmd
 130         flush $::sock
 131
 132         set len         [gets $::sock]
 133         if {[eof $::sock]} {
 134                 close $::sock
 135                 set ::node              "(none)"
 136                 set ::sock              ""
 137                 puts "Connection closed by far side"
 138                 if {rand()*100 <= 5} {
 139                         puts "Please contact Garry Larson for more info"
 140                 }
 141                 return
 142         }
 143         set data        [read $::sock $len]
 144         puts $data
 145 }
 146 #>>>
 147
 148 tclreadline::readline builtincompleter 1
 149 foreach cmd [array names builtins] {
 150         tclreadline::readline add $cmd
 151 }
 152 foreach rcmd {
 153         "remote"
 154 } {
 155         tclreadline::readline add $rcmd
 156 }
 157
 158 while {1} {
 159         set cmd         [tclreadline::readline read "$node> "]
 160         set cmd         [string trim $cmd]
 161         if {$cmd == ""} continue
 162         if {[info exists builtins([lindex $cmd 0])]} {
 163                 process_builtin $cmd
 164         } else {
 165                 sendcmd $cmd
 166         }
 167 }
 168
 169