#! /usr/bin/tclsh # # send stdin to an XOS server, # echo the XOS reply from that socket to stdout # then exit. # # usage: # echo "gtos_start_move detector_z 100" | xos_exchange.tcl host count keytext timeout # # # read command line set host [lindex $argv 0] set lines [lindex $argv 1] set keytext [subst -nocommands -novariables [lindex $argv 2]] set timeout [lindex $argv 3] # impose defaults set port 14242 if { "$timeout" == ""} { set timeout 30 } if { "$keytext" == ""} { set keytext "\n" } if { "$lines" == ""} { set lines -1} if { "$port" == ""} { set port 14242 } if { "$host" == ""} { set host localhost } # alternate interpretations of the command line if { ! [string is digit $lines] } { set lines -1 } # initialize common variables set status "normal" set cmplen [string length $keytext] set window [expr $cmplen - 1] # open the first socket connection (usually to get the new port) set sock [socket $host $port] fconfigure $sock -buffering none -translation binary -blocking 1 set message [read $sock 200] set message [string range $message 0 [string first "\0" $message]] close $sock scan [string range $message [expr [string wordend $message 0]+1] end] "%d" port # open the second socket connection (on the listening port we were given by the first) #puts "listening $host server is on $port" set sock [socket $host $port] fconfigure $sock -buffering none -translation binary -blocking 1 # claim to be a gui (what else are we going to be?) set tosend "gtos_client_is_gui" #append tosend "\0" while {[string length $tosend] < 200} {append tosend " "} puts -nonewline $sock $tosend #puts "connected" fconfigure stdin -buffering line -translation lf #fconfigure stdout -translation binary -blocking 0 #-translation {auto auto} # check for failed connection # now define procedures for handling this proc bgerror { code } { global sock puts stderr "bgerror: $code" set status "bgerror" flush $sock close $sock exit 2 } proc timeout {} { global timeout # puts stderr "idle" after [expr int( $timeout * 1000 ) ] { # puts stderr "timeout" set status "timeout" } } # send everything from stdin to the remote socket as an XOS message proc send_request {sock} { global status # cancel this procedure when there is no more input if { [eof stdin] } { fileevent $sock writable "" rename send_request "" return } # postpone timeout if there is input to process after cancel [after info] after idle timeout # read data from std input and send it to the remote computer as a 200-byte asciiz string set tosend [gets stdin] # append tosend "\0" if {! [string length $tosend]} return while {[string length $tosend] < 200} {append tosend " "} puts -nonewline $sock $tosend # puts stderr "sending: |$tosend|" } proc read_reply {sock} { # almost everything is global (xos_exchange will only use one socket) global lines reply cmplen window keytext status # postpone timeout if there is input to process after cancel [after info] after idle timeout # echo "real" text of reply to std output set message [read $sock 200] # append reply "$string" # if{ [string length $reply] < 200 } return set message [string range $message 0 [expr [string first "\0" $message]-1]] # print out the character if { [catch {puts "$message"} foo] } { # must be a broken pipe #puts stderr "broken pipe " set status "broken pipe" return } # count down the number of "lines" read (keytexts "seen") if { [string match "*$keytext*" "$message"] } { incr lines -1 } # check for completed read if { $lines == 0} { set status "normal" return } # check for broken socket if { [eof $sock] } { #puts stderr "socket broken by remote host " set status "closed" return } } fileevent $sock readable [list read_reply $sock] fileevent $sock writable [list send_request $sock] after idle timeout vwait status # close up flush $sock close $sock if {$status != "normal"} { # puts stderr "$status" exit 9 } exit