I'm writing a socket utility to communicate a client to a server. When input to the socket from the client side, the server is receiving it fine. However, when input to the socket from the server, the client can't read. When checking for fblocked $channel. It is 1. I've tried everything including adding new line, ...
Please help.
Below is my code
proc read_command { sock } {
variable self
global connected
set len [gets $sock line]
set bl [fblocked $sock]
puts "Characters Read: $len Fblocked: $bl"
if {$len < 0} {
if {$bl} {
puts "Input is blocked"
} else {
set connected 1
puts "The socket was closed - closing my end"
close $sock
}
} else {
if {!$bl} {
puts "Read $len characters: $line"
catch {uplevel #0 $line} output
puts "1==>$output<=="
puts $sock "$output"
puts $sock "\n"
flush $sock
}
}
}
proc client { host port } {
variable self
set s [socket $host $port]
set self(csock) $s
set self($s,addr) $host
set self($s,port) $port
fconfigure $s -buffering line -blocking 0
return $s
}
proc prun { sock args} {
variable self
set result [list]
set cmd $args
set cmd [regsub -all {(^\s*\{)||(\}\s*$)} $cmd ""]
set cmd [string trimleft $cmd]
set o1 [eval $cmd]
#catch {uplevel #0 $cmd} o1
puts "1_$sock ==> $o1"
lappend result $o1
#--------------
puts $sock $cmd
flush $sock
set bl [fblocked $sock]
set file [read $sock]
set bl [fblocked $sock]
puts "Fblocked: $bl"
puts "Output: $file"
puts "2_$Comm::self(csock) ==> $file ==> $bl"
lappend result $file
return $result
}
Here is how I run it.
I call server on 1 of the terminal. It will echo the ip address and the port.
Then I call client using the address and the port above to get back the client socket
Then I call prun on the client shell to get back a pair of values, one with the value of the cmd call on the client, and the other the value of the cmd call on the server. Basically I would like to get the pair of values so I can use them for correlation between the 2 set of data.
Below is the code:
1.
On server shell
$ server
2.
On client shell
$ set s [client $addr $port]
3.
Call a proc to get the value from the client shell, then send the command to the server to get the value from the server shell, and return that value back to the client.
$ set res [prun $s {set val [get_attribute [get_nets mynet] pin_capacitance_max]}]
You wrote:
puts "2_$Comm::self(csock) ==> $file ==> $bl"
and defined self with variable. Are you working with packages?. May be you forgot something related to it.
For test you can use just global but using arrays would be a little more complicated.
Related
Could you tell me what in this code would cause the chan event $sock readable [list ReadLine $sock] to repeatedly be fired after a socket has been reset?
I'm trying to keep the socket open on an extremely simple local server by resetting the socket to read again at the first line.
I'm not sure if it is the browser or the Tcl code. I flush the socket before sending each response using chan flush $sock; so, I don't think there should be any data left in the input buffer to fire the readable event.
Everything works fine until I stop using the application for a few minutes, and then procedure ReadLine is repeatedly invoked with a state of 1 but no data.
I included procedure GetLexi at the end because its the one I've been testing when this started occurring and, perhaps, I'm doing something wrong there and the browser doesn't know the response is complete. I should add also that it is called from with procedure GetHandler and should return back to the switch block and be reset. I did test that the socket is reset after an invocation of GetLexi.
Thank you for any guidance you may be able to provide.
proc ResetSock {sock} {
global state
set state($sock) {1}
chan configure $sock -encoding iso8859-1 -translation crlf
}; #close ResetSock
proc ClientConnect {sock client_ip client_port} {
global state
if {![info exists state($sock)]} {
set state($sock) {1}; # 1 for first line; 2 for any other header line.
chan configure $sock -buffering line -blocking 0 -encoding iso8859-1 -translation crlf
}
chan event $sock readable [list ReadLine $sock]
}; #close ClientConnect
proc ReadLine {sock} {
global state
set sptr state($sock)
set row [lindex [set $sptr] 0]
if {[catch {gets $sock line} len]} {
# Handle this error.
return
}
if {$len == 0} {
#According to Tclhttpd, in between requests, a row 1 and len 0
#combination can occur. There, it is ignored.
if {$row == 2 } {
switch [lindex [set $sptr] 1] {
"POST" {
set post [PostHandler $sock [lindex [set $sptr] 3]]
puts stdout "Posted: $post"
ResetSock $sock
}
"GET" {
GetHandler $sock [lindex [set $sptr] 2]
ResetSock $sock
}
default { CloseSock $sock }
}
}
} elseif {$len > 0} {
switch $row {
1 {
# First row of request.
lassign [split [string trim $line]] op arg rest
lappend $sptr $op $arg
lset $sptr 0 0 2
}
2 {
# Read headers.
}
default { }
}
} else {
# Only other option for $len is a negative value;
# thus, an error to be handled.
}
}; #close ReadLine
proc GetLexi { nbr sock } {
chan flush $sock
set sql { select img_base64 from lexi_raw where strongs_no = $nbr }
dbws eval $sql {
set lexi [binary format a* "{\"lexi\":\"$img_base64\"}"]
}
set headers ""
append headers "HTTP/1.1 200 OK\n"
append headers "Content-Type: application/json; charset: utf-8\n"
append headers "Content-length: [string length $lexi]\n"
append headers "Connection: Keep-Alive\n"
puts $sock $headers
chan configure $sock -translation binary
puts $sock $lexi
}; #close GetLexi
set state(x) {}
if [catch {set listener [socket -server ClientConnect -myaddr 127.0.0.1 8000]}] {
error "couldn't open listening socket"
}
vwait forever
catch {close $listener}
It's possible for the amount of data received in a packet to be not enough to complete a line. TCP hides most of the details, of course, but it remains entirely possible for the readable event to fire when a complete line is not available. As you've put the socket in non-blocking mode, that means that gets will do a zero length read (empty string written to line, len becomes 0); if the socket was blocking, the gets would block the thread until a complete line was available. You can also get zero-length reads if the channel is closed; detection of closure isn't very reliable with TCP (because networking is like that) but may happen. When the socket is closed, all reading from it in non-blocking mode results in zero-length results.
How do you distinguish these cases?
First, we check for end-of-stream:
if {[chan eof $sock]} {
# It's gone; there's not much else you can do at this point except log it I guess
close $sock
return
}
Then we need to see if things are blocked, and if so, how much is buffered:
if {[chan blocked $sock]} {
set bufferSize [chan pending input $sock]
if {$bufferSize > 4096} { # 4k is enough for most things
# Line is too long; client not well-behaved…
# You *might* send an error here.
close $sock
return
}
}
If it's neither of those cases, we've actually read a line.
if {$len == 0} {
# Empty line; end of HTTP header
} else {
# etc.
}
When attempting to return a multi-line output via TCL server, the server reports a broken pipe even though the client is able to receive all the data.
Server:
proc Echo_Server {port} {
set s [socket -server EchoAccept $port]
vwait forever
}
proc EchoAccept {sock addr port} {
puts "Accept $sock from $addr port $port"
fconfigure $sock -buffering line
fileevent $sock readable [list Echo $sock]
}
proc Echo {sock} {
if { [eof $sock] || [catch {gets $sock line}] } {
puts "Close $sock"
close $sock
} else {
set returnData "
Hi
How are you?
This is test data
Close
"
puts $sock $returnData
puts $sock "EOF"
flush $sock
}
}
Echo_Server 2500
vwait forever
Client code to send/receive data:
proc Echo_Client {host port} {
set s [socket $host $port]
fconfigure $s -buffering full -buffersize 1000000
#fconfigure $s -buffering line -blocking 0
return $s
}
set s [Echo_Client localhost 2500] ; puts $s "dummy command" ; flush $s
set pp 1 ; while { $pp == 1 } { set line [gets $s] ; puts $line ; if { [regexp "EOF" $line] } { set pp 0 } } ; flush $s ; close $s
The client receives the data sent from the server but the server reports the following:
% source /edascratch/nobackup/sanjaynn/scripts/simple_server.tcl
Accept sock6 from 127.0.0.1 port 59814
error writing "sock6": broken pipe
while executing
"puts $sock $returnData"
(procedure "Echo" line 15)
invoked from within
"Echo sock6"
Is there something obvious that I am missing?
The [eof $sock] condition isn't set before the read in [gets $sock line], and the [gets] call doesn't return an error here, it returns -1 to indicate that there's no data available. Just reverse the conditions order and the server will start working properly:
...
if { [catch {gets $sock line}] || [eof $sock] } {
...
# Prints the string in a file
puts $chan stderr "$timestamp - Running test: $test"
# Prints the string on a console
puts "$timestamp - Running test: $test"
Is there a way I can send the output of puts to the screen and to a log file at the same time? Currently I have both the above two lines one after the other in my script to achieve this.
Or is there any other solution in tcl ?
Use the following proc instead of puts:
proc multiputs {args} {
if { [llength $args] == 0 } {
error "Usage: multiputs ?channel ...? string"
} elseif { [llength $args] == 1 } {
set channels stdout
} else {
set channels [lrange $args 0 end-1]
}
set str [lindex $args end]
foreach ch $channels {
puts $ch $str
}
}
Examples:
# print on stdout only
multiputs "1"
# print on stderr only
multiputs stderr "2"
set brieflog [open brief.log w]
set fulllog [open detailed.log w]
# print on stdout and in the log files
multiputs stdout $brieflog $fulllog "3"
This isn't something I've used extensively, but it seems to work (Tcl 8.6+ only):
You need the channel transform tcl::transform::observe package:
package require tcl::transform::observe
Open a log file for writing and set buffering to none:
set f [open log.txt w]
chan configure $f -buffering none
Register stdout as a receiver:
set c [::tcl::transform::observe $f stdout {}]
Anything written to the channel $c will now go to both the log file and stdout.
puts $c foobar
Note that it would seem to make more sense to have the channel transformation on top of stdout, with the channel to the log file as receiver, but I haven't been able to make that work.
Documentation:
chan,
open,
package,
puts,
set,
tcl::transform::observe (package)
If the server went into a infinite loop, how we can close the server connection after sometime?
Here is the code in which I am trying:
set s [socket $host $port]
fconfigure $s -blocking 1 -buffering line
after 2000 set end 1
vwait end
if { $s != "" } {
puts -nonewline $s "$msg\n.\n"
flush $s
fileevent $s readable [set answer [read $s]]
puts "$answer"
if {[catch {close $s}]} {
puts "Server hanged"
}
This above code is working if the answer was given by the server without any problem. If the server went into infinite loop, it is keep on hanging in read $s. Please help on how to handle this read socket in a non-blocking mode as like in fconfigure.
If you're using blocking sockets, you'll have this problem: putting the channel in non-blocking mode is the fix (together with using after to write a timeout). This does mean that you'll have to deal with all the complexity of asynchronous programming, but that's the tradeoff that you need here.
The two places where things can hang are in connection establishment and in production of the data. You would therefore use asynchronous connection and non-blocking retrieval.
set s [socket -async $host $port]
fconfigure $s -blocking 0
fileevent $s writeable [list connected $s]
proc connected {s} {
global msg
fileevent $s writeable {}
puts -nonewline $s "$msg\n.\n"
flush $s
fileevent $s readable [list accumulateBytes $s]
}
set accumulate ""
proc accumulateBytes {s} {
global accumulate end
append accumulate [read $s]
if {[eof $s]} {
set end 0
}
}
# Longer *total* time to connect and communicate.
after 5000 set end 1
vwait end
catch {close $s}
if {$end} {puts "timed out"}
puts "received message: $accumulate"
I am new at TCL and trying an example within a book called Practical Programming.
I am trying to connect to an echo server with a client within the same file. So I have made a file called EchoServer.tclsh. I then have written the echo server code within this and the echoclient code. When I run this I receive an error that shows:
couldn't open socket: connection refused
while executing
"socket $host $port"
(procedure "Echo_Client" line 2)
invoked from within
"Echo_Client localhost 2540"
invoked from within
"set s [Echo_Client localhost 2540]"
(file "echo_server.tcl" line 35)
The code for the server is:
proc Echo_server {port} {
global echo
set echo(main) {socket -server EchoAccept $port}
}
proc EchoAccept {sock addr port} {
global echo
puts "Accept $sock from $addr port $port"
set echo(addr,$sock) [list $addr $port]
f configure $sock -buffering line
fileevent $sock readable [list Echo $sock]
}
proc Echo {sock} {
global echo
if {[eof $sock] || [catch {gets $sock line}]} {
# end of file or abnormal connection drop
close $sock
puts "Close $echo(addr,$sock)"
unset echo(addr,$sock)
} else {
if {[string compare $line "quit"] ==0} {
# Prevent new connections.
# Existing connections stay open.
close $echo(main)
}
puts $sock $line
}
}
The code for the client is:
proc Echo_Client {host port} {
set s [socket $host $port]
fconfigure $s -buffering line
return $s
}
set s [Echo_Client localhost 2540]
puts $s "Hello!"
gets $s
the line
set echo(main) {socket -server EchoAccept $port}
should be
set echo(main) [socket -server EchoAccept $port]
And enter the event loop by doing a
vwait forever
at the end