Tcl Socket help

[Charlie Bursell]

I haven't done much (anything) with Tcl sockets and woul like some
ideas

The problem.

Connect to a server, send a message, get response, send another
message, get response then finished

After sending the message I don't want to wait more that 20 seconds or
so for a response, in other words time out. Depending on the size of
the message each response may require several reads.

I assume I would do this with a combination of the after command and
vwait? All my trial thius far have not worked as required.

Any ideas or even pointers to examples would be greatly appreciated

[Harald Oehlmann]

Here is an example (untested):

# !/bin/sh
# \
exec tclsh8.5 "$0" "$@"

# > Cmd-Line
set Pos 0
# > Problems with an empty phantom argument on win98
if {$argc == 1} {
set argv [lindex $argv 0]
}
puts "Argv=$argv [llength $argv]"
set Config(Indexes) {IP Port}
foreach Index $Config(Indexes)\
Default {127.0.0.1 5000}\
{
if {$Pos < [llength $argv]} {
set Config($Index) [lindex $argv $Pos]
} else {
set Config($Index) $Default
}
incr Pos
}
puts "emulspc [array get Config]"
proc ShowState {Text} {
puts "State:$Text"
}
proc ShowError {Msg} {
puts stderr $Msg
exit
}
proc OpenSocket {} {
variable Config
if {[info exists Config(SId)]} {
CloseSocket
}
if {"" eq $Config(IP) || "" eq $Config(Port)} {
return
}
# > Socket
if {[catch {
set SId [socket -async $Config(IP) $Config(Port)]
fconfigure $SId -blocking 0 -buffering none -translation binary\
-encoding binary
fileevent $SId readable [list ReadSocket]
fileevent $SId writable [list WritableSocket]
} Err]} {
ShowError "Error opening socket $Config(IP):$Config(Port): $Err"
} else {
set Config(SId) $SId
ShowState "Socket $Config(IP):$Config(Port) opened"
}
}
proc CloseSocket {} {
variable Config
if {[info exists Config(SId)]} {
if {[catch {
close $Config(SId)
} Err]} {
ShowError "Error closing socket $Config(IP):$Config(Port): $Err"
}
ShowState "Socket $Config(IP):$Config(Port) closed"
unset Config(SId)
}
}
proc WritableSocket {} {
variable Config
TimeoutCancel
if {![info exists Config(SId)]} {
return
}
if {[catch { fileevent $Config(SId) writable "" } Err]} {
ShowError "Error canceling write socket $Config(IP):$Config(Port):
$Err"
}
puts "Socket connected"
ShowState "Socket $Config(IP):$Config(Port) connected"
TimeoutStart
Send "First message"
}
# > Read Socket
proc ReadSocket {} {
variable Config
if {[ catch {
set Data [read $Config(SId)]
} Err]} {
CloseSocket
ShowError "Error reading socket $Config(IP):$Config(Port): $Err"
return
}
puts "Received:$Data"
append Config(SocketData) $Data
# Update
while { [regexp -- {([^\x0d]*)\x0d(.*)$} $Config(SocketData) match\
Data Config(SocketData)]
} {
TimeoutCancel
TimeoutStart
Send "Consecutive message"
}
if {[eof $Config(SId)]} {
CloseSocket
ShowError "Server closed socket"
}
}

# > Send data
proc Send {Data} {
variable Config
append Data \x0d
if {![info exists Config(SId)]} {
OpenSocket
if {![info exists Config(SId)]} {
return
}
}
ShowState "Send $Data"
if {[ catch {
puts -nonewline $Config(SId) $Data
flush $Config(SId)
} Err]} {
ShowError "Error writing socket $Config(IP):$Config(Port): $Err"
CloseSocket
return
}
}
proc Timeout {} {
variable Config
unset Config(TId)
ShowError "Timeout"
return
}
proc TimeoutStart {{Time 5000}} {
variable Config
TimeoutCancel
set Config(TId) [after 5000 Timeout]
}
proc TimeoutCancel {} {
variable Config
if {[info exists Config(TId)]} {
after cancel $Config(TId)
unset Config(TId)
}
}
# > Connect timeout
TimeoutStart
OpenSocket

vwait forever