#! /bin/sh
# use tclsh in the path \
exec tclsh "$0" "$@"
#
#    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 count keytext timeout dcss_server
#
#
set beamline [lindex [array get env beamline] 1]

# first, we need to figure out where the auth package is...
if {[file exist "/usr/local/dcs/tcl_clibs/linux64/tcl_clibs.so"]} {
   catch { load /usr/local/dcs/tcl_clibs/linux64/tcl_clibs.so dcs_c_library }
}
set SID ""
if {[file exist "~/.bluice/session"]} {   
	set file [open "~/.bluice/session"]
	set SID [read $file]
	close $file
	if { [ catch {
	    package require Itcl
	    namespace import ::itcl::*
	    package require DCSAuthClient
                     } error_message ]
            } {
	    # unable to load packages
        } else {
	    # must be version 5
        }
}
#load /usr/local/dcs/tcl_clibs/irix/tcl_clibs.so dcs_c_library


# read command line
set lines [lindex $argv 0]
set keytext [subst -nocommands -novariables [lindex $argv 1]]
set timeout [lindex $argv 2]
set host [lindex $argv 3]


# impose defaults
set port 14243
if { "$SID" != ""} { set port 14343 } 
if { "$timeout" == ""} { set timeout 30 }
if { "$keytext" == ""} { set keytext "\n" }
if { "$lines" == ""} { set lines -1}
if { "$port" == ""}  { set port 14243 }
if { "$host" == ""}  { set host delphi }

# 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]
set clientid ""
set sending 0

# now define procedures for handling the XOS session

proc bgerror { code } {
    global xos_sock
    puts stderr "bgerror: $code"
    set status "bgerror"
    flush $xos_sock
    close $xos_sock
    exit 2
}

proc timeout {} {
    global timeout
#    puts stderr "idle"
    after [expr int( $timeout * 1000 ) ] {
#	puts stderr "timeout"
	set status "timeout"
    }
}

proc od { binary } {
    set encoded ""

    foreach byte [ split $binary "" ] {
	# examine and report bytes sent from the client
	binary scan $byte c byteval
	while {$byteval < 0} {set byteval [expr $byteval + 256]}
	set char [format "\\%03o" $byteval]
	
	if {$byteval > 47 && $byteval < 60} { set char $byte }
	if {$byteval > 65 && $byteval < 90} { set char $byte }
	if {$byteval > 96 && $byteval < 123} { set char $byte }
	if {$byteval == 0} {set char "\\0"}
	if {$byteval == 7} {set char "\\a"}
	if {$byteval == 8} {set char "\\b"}
	if {$byteval == 9} {set char "\\t"}
	if {$byteval == 10} {set char "\\n"}
	if {$byteval == 11} {set char "\\v"}
	if {$byteval == 12} {set char "\\f"}
	if {$byteval == 13} {set char "\\r"}
	if {$byteval == 32} {set char " "}
	if {$byteval == 95} {set char "_"}
	if {$byteval == 46} {set char "."}

	set encoded "${encoded}$char"
    }
    return $encoded
}


# send everything from stdin to the remote socket as an XOS message
proc send_request {sock} {
    global status clientid SID


    # 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 an XOS3 message
    set message [gets stdin]

    # check for info we might need from this, particular stream
    if { [string match "*start_operation*" "$message"] } {
	# edit the operation handle so that it will be accepted from this "client"
	set ophandle [lindex "$message" 2]
	set ophandle [expr $ophandle - int($ophandle) + $clientid]
	set message [lreplace "$message" 2 2 "$ophandle"]
	# add any session ID so that this will be accepted from this "client"
	if { "$SID" != "" } {
	    set message "$message $SID"
	}
    }

    # pass it along as an XOS3 packet
#    puts stderr "sending: |$tosend|"
    send_xos3 $message
}

# general procedure for shipping off a message/data pair over XOS3 protocol
proc send_xos3 { message {data ""} } {
    global xos_sock

    set mcount [string length $message]
    set dcount [string length $data]
    
    if { $mcount == 0 && $dcount == 0 } {return}
#    append message "\0"
#    incr mcount
    
    set header [format "%12d %12d " $mcount $dcount]
    
#puts "GOTHERE -> [format "%12d %12d %s%s" $mcount $dcount [od $message] [od $data]]"
    puts -nonewline $xos_sock "${header}${message}${data}"
}
proc send_xos1 { message } {
    global xos_sock
    
#puts "GOTHERE -> [od $message]"
    set mcount [string length $message]
    if { $mcount < 200 } {
	append message "\0"
	incr mcount
    }

    if { $mcount == 0 } {return}
    while { [string length $message] < 200 } { append message " "}
    
    puts -nonewline $xos_sock $message
}


proc read_reply {sock} {

    # almost everything is global (xos_exchange will only use one socket)
    global lines reply cmplen window keytext status env clientid sending SID
    
    # postpone timeout if there is input to process
    after cancel [after info]
    after idle timeout

    # get the XOS3 header
    set mcount 200
    set dcount 0
    set header [read $sock 26]
    if { [eof $sock] } {exit 9}
    scan $header "%d%d" mcount dcount

    # get the text message part of the packet
    set message [read $sock $mcount]
    set data [read $sock $dcount]
#puts "GOTHERE <- [od "${header}${message}${data}"]"

    # strip the zero off the end of the message
    if { [string match "*\0" "$message" ] } {
        set message [string range "$message" 0 end-1]
    }

    # print out the message to stdout
    if { [catch {puts "$message"} error_message] } {
	# must be a broken pipe
	#puts stderr "broken pipe "
	set status "broken pipe"
	return
    }

    # generate required login replies
    if { [string match "*send_client_type*" "$message"] } {
#puts "GOTHERE sending client type..."
	set user $env(USER)
	#set host [lindex [split $env(HOST) "."] 0]
	set host $env(HOST)
#	set host "localhost"
	set message "gtos_client_is_gui $user $SID $host $env(DISPLAY)"
	send_xos1 $message
	return
    }
    if { [string match "*respond_to_challenge*" "$message"] } {
#puts "GOTHERE responding to challenge..."
	set user $env(USER)
        set response [generate_auth_response $user $data]
	send_xos1 $response
    }
    if { [string match "*login_complete*" "$message"] } {
	set clientid [lindex $message 1]
	return
    }
    if { [string match "*update_client*" "$message"] && ! $sending } {
#puts "GOTHERE forwarding stdin to remote socket"
	fileevent $sock writable [list send_request $sock]
	set sending 1
	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
    }
}


# open the socket connection
set sock [socket $host $port]
set xos_sock $sock
fconfigure $sock -buffering none -translation binary -blocking 1
fconfigure stdin -buffering line -translation lf

fileevent $sock readable [list read_reply $sock]
after idle timeout
vwait status

# close up
flush $sock
close $sock
if {$status != "normal"} {
#    puts stderr "$status"
    exit 9
}
exit