summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--tests/socket.test37
-rw-r--r--unix/tclUnixSock.c66
2 files changed, 63 insertions, 40 deletions
diff --git a/tests/socket.test b/tests/socket.test
index dd57a3d..b121022 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -71,6 +71,23 @@ testConstraint exec [llength [info commands exec]]
# from 49152 through 65535.
proc randport {} { expr {int(rand()*16383+49152)} }
+# Test the latency of tcp connections over the loopback interface. Some OSes
+# (e.g. NetBSD) seem to use the Nagle algorithm and delayed ACKs, so it takes
+# up to 200ms for a packet sent to localhost to arrive. We're measuring this
+# here, so that OSes that don't have this problem can
+set server [socket -server {apply {{s a p} {set ::s1 $s}}} 0]
+set s2 [socket localhost [lindex [fconfigure $server -sockname] 2]]
+vwait s1; close $server
+fconfigure $s1 -buffering line
+fconfigure $s2 -buffering line
+set t1 [clock milliseconds]
+puts $s2 test1; gets $s1
+puts $s2 test2; gets $s1
+close $s1; close $s2
+set t2 [clock milliseconds]
+set latency [expr {$t2-$t1}]
+unset t1 t2 s1 s2 server
+
# If remoteServerIP or remoteServerPort are not set, check in the environment
# variables for externally set values.
#
@@ -584,7 +601,7 @@ test socket_$af-2.11 {detecting new data} -constraints [list socket supported_$a
fconfigure $sock -blocking 1
puts $s2 two
flush $s2
- after idle {set x 1}
+ after $latency {set x 1}; # NetBSD fails here if we do [after idle]
vwait x
fconfigure $sock -blocking 0
lappend result c:[gets $sock]
@@ -1713,12 +1730,14 @@ test socket-14.0 {[socket -async] when server only listens on one address family
set port [lindex [fconfigure $server -sockname] 2]
} -body {
set client [socket -async localhost $port]
- after 1000 {set x [fconfigure $client -error]}
+ set after [after 1000 {set x [fconfigure $client -error]}]
vwait x
set x
} -cleanup {
+ after cancel $after
close $server
close $client
+ unset x
} -result ok
test socket-14.1 {[socket -async] fileevent while still connecting} \
-constraints [list socket supported_any] \
@@ -1727,13 +1746,15 @@ test socket-14.1 {[socket -async] fileevent while still connecting} \
global x
puts $s bye
close $s
- set x ok
+ lappend x ok
}
- set server [socket -server accept -myaddr 127.0.0.1 2222]
+ set server [socket -server accept -myaddr 127.0.0.1 0]
set port [lindex [fconfigure $server -sockname] 2]
} -body {
set client [socket -async localhost $port]
- fileevent $client readable {lappend x [fconfigure $client -error]}
+ fileevent $client writable {
+ lappend x [expr {[fconfigure $client -error] eq ""}]
+ }
set after [after 1000 {set x timeout}]
vwait x
vwait x
@@ -1742,18 +1763,20 @@ test socket-14.1 {[socket -async] fileevent while still connecting} \
after cancel $after
close $server
close $client
- } -result {ok {}}
+ unset x
+ } -result {ok 1}
test socket-14.2 {[socket -async] fileevent connection refused} \
-constraints [list socket supported_any] \
-body {
set client [socket -async localhost 0]
- fileevent $client readable {set x [fconfigure $client -error]}
+ fileevent $client writable {set x [fconfigure $client -error]}
set after [after 1000 {set x timeout}]
vwait x
set x
} -cleanup {
after cancel $after
close $client
+ unset x
} -result "connection refused"
::tcltest::cleanupTests
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index 823942a..981162d 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -885,10 +885,12 @@ CreateClientSocket(
Tcl_Interp *interp, /* For error reporting; can be NULL. */
TcpState *state)
{
+ socklen_t optlen;
+ int in_coro = (state->addr != NULL);
int status, connected = 0;
int async = state->flags & TCP_ASYNC_CONNECT;
- if (state->addr != NULL) {
+ if (in_coro) {
goto coro_continue;
}
@@ -966,53 +968,51 @@ CreateClientSocket(
Tcl_CreateFileHandler(state->fds->fd, TCL_WRITABLE,
TcpAsyncCallback, state);
return TCL_OK;
+
coro_continue:
- do {
- socklen_t optlen = sizeof(int);
- Tcl_DeleteFileHandler(state->fds->fd);
- getsockopt(state->fds->fd, SOL_SOCKET, SO_ERROR,
- (char *)&status, &optlen);
- state->status = status;
- } while (0);
+ Tcl_DeleteFileHandler(state->fds->fd);
+ /*
+ * Read the error state from the socket, to see if the async
+ * connection has succeeded or failed and store the status in
+ * the socket state for later retrieval by [fconfigure -error]
+ */
+ optlen = sizeof(int);
+ getsockopt(state->fds->fd, SOL_SOCKET, SO_ERROR,
+ (char *)&status, &optlen);
+ state->status = status;
}
if (status == 0) {
- connected = 1;
- break;
+ goto out;
}
}
- if (connected) {
- break;
- }
}
- if (async) {
- /*
- * Restore blocking mode.
- */
- status = TclUnixSetBlockingMode(state->fds->fd, TCL_MODE_BLOCKING);
- }
+out:
freeaddrinfo(state->addrlist);
freeaddrinfo(state->myaddrlist);
if (async) {
CLEAR_BITS(state->flags, TCP_ASYNC_CONNECT);
- if (state->filehandlers != 0) {
- TcpWatchProc(state, state->filehandlers);
- }
- return TCL_OK;
+ TcpWatchProc(state, state->filehandlers);
+ TclUnixSetBlockingMode(state->fds->fd, TCL_MODE_BLOCKING);
}
+
if (status < 0) {
- if (interp != NULL) {
- Tcl_AppendResult(interp, "couldn't open socket: ",
- Tcl_PosixError(interp), NULL);
- }
- if (state->fds->fd != -1) {
- close(state->fds->fd);
- }
- ckfree(state->fds);
- ckfree(state);
- return TCL_ERROR;
+ if (in_coro) {
+ Tcl_NotifyChannel(state->fds->fd, TCL_WRITABLE);
+ } else {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "couldn't open socket: ",
+ Tcl_PosixError(interp), NULL);
+ }
+ if (state->fds->fd != -1) {
+ close(state->fds->fd);
+ }
+ ckfree(state->fds);
+ ckfree(state);
+ return TCL_ERROR;
+ }
}
return TCL_OK;
}