summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--tests/socket.test15
-rw-r--r--unix/tclUnixSock.c67
-rw-r--r--win/tclWinSock.c38
3 files changed, 116 insertions, 4 deletions
diff --git a/tests/socket.test b/tests/socket.test
index 0c9320a..b006cb4 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -67,10 +67,19 @@ namespace import -force ::tcltest::*
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
testConstraint exec [llength [info commands exec]]
+
# Produce a random port number in the Dynamic/Private range
# from 49152 through 65535.
proc randport {} { expr {int(rand()*16383+49152)} }
+# Check if socket_test option is available
+testConstraint sockettest [expr {![catch {
+ set h [socket -async localhost [randport]]
+ fconfigure $h -unsupported1 1
+ close $h
+ }]}]
+
+
# 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
@@ -2148,7 +2157,7 @@ test socket-14.10.1 {pending [socket -async] and nonblocking [puts], server is I
close $sock
} -result {{} ok}
test socket-14.11.0 {pending [socket -async] and nonblocking [puts], no listener, no flush} \
- -constraints {socket} \
+ -constraints {socket } \
-body {
set sock [socket -async localhost [randport]]
fconfigure $sock -blocking 0
@@ -2161,12 +2170,14 @@ test socket-14.11.0 {pending [socket -async] and nonblocking [puts], no listener
unset x
} -result {socket is not connected} -returnCodes 1
test socket-14.11.1 {pending [socket -async] and nonblocking [puts], no listener, flush} \
- -constraints {socket} \
+ -constraints {socket sockettest} \
-body {
set sock [socket -async localhost [randport]]
+ fconfigure $sock -unsupported1 1
fconfigure $sock -blocking 0
puts $sock ok
flush $sock
+ fconfigure $sock -unsupported1 0
fileevent $sock writable {set x 1}
vwait x
close $sock
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index a9323c4..cf5d7b9 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -89,6 +89,9 @@ struct TcpState {
* flag indicates that reentry is
* still pending */
#define TCP_ASYNC_FAILED (1<<5) /* An async connect finally failed */
+#define TCP_ASYNC_TEST_MODE (1<<6) /* Async testing activated
+ * Do not automatically continue connection
+ * process */
/*
* The following defines the maximum length of the listen queue. This is the
@@ -125,6 +128,9 @@ static int TcpClose2Proc(ClientData instanceData,
Tcl_Interp *interp, int flags);
static int TcpGetHandleProc(ClientData instanceData,
int direction, ClientData *handlePtr);
+static int TcpSetOptionProc(ClientData instanceData,
+ Tcl_Interp *interp, const char *optionName,
+ const char *value);
static int TcpGetOptionProc(ClientData instanceData,
Tcl_Interp *interp, const char *optionName,
Tcl_DString *dsPtr);
@@ -147,7 +153,7 @@ static const Tcl_ChannelType tcpChannelType = {
TcpInputProc, /* Input proc. */
TcpOutputProc, /* Output proc. */
NULL, /* Seek proc. */
- NULL, /* Set option proc. */
+ TcpSetOptionProc, /* Set option proc. */
TcpGetOptionProc, /* Get option proc. */
TcpWatchProc, /* Initialize notifier. */
TcpGetHandleProc, /* Get OS handles out of channel. */
@@ -439,6 +445,21 @@ WaitForConnect(
if (!(statePtr->flags & TCP_ASYNC_PENDING)) {
return 0;
}
+
+ /*
+ * In socket test mode do not continue with the connect
+ * Exceptions are:
+ * - Call by recv/send and blocking socket
+ * (errorCodePtr != NULL && ! flags & TCP_NONBLOCKING)
+ */
+
+ if ( (statePtr->flags & TCP_ASYNC_TEST_MODE)
+ && !(errorCodePtr != NULL && !(statePtr->flags & TCP_NONBLOCKING))) {
+ if (errorCodePtr != NULL) {
+ *errorCodePtr = EWOULDBLOCK;
+ }
+ return -1;
+ }
if (errorCodePtr == NULL || (statePtr->flags & TCP_NONBLOCKING)) {
timeout = 0;
@@ -748,6 +769,50 @@ TcpHostPortList(
/*
*----------------------------------------------------------------------
*
+ * TcpSetOptionProc --
+ *
+ * Sets Tcp channel specific options.
+ *
+ * Results:
+ * None, unless an error happens.
+ *
+ * Side effects:
+ * Changes attributes of the socket at the system level.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TcpSetOptionProc(
+ ClientData instanceData, /* Socket state. */
+ Tcl_Interp *interp, /* For error reporting - can be NULL. */
+ const char *optionName, /* Name of the option to set. */
+ const char *value) /* New value for option. */
+{
+ TcpState *statePtr = instanceData;
+
+ /*
+ * Set socket test int value
+ */
+ if (!strcmp(optionName, "-unsupported1")) {
+ int intValue;
+ if (Tcl_GetInt(interp, value, &intValue) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (intValue & 1) {
+ SET_BITS(statePtr->flags,TCP_ASYNC_TEST_MODE);
+ } else {
+ CLEAR_BITS(statePtr->flags,TCP_ASYNC_TEST_MODE);
+ }
+ return TCL_OK;
+ }
+
+ return Tcl_BadChannelOption(interp, optionName, "");
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TcpGetOptionProc --
*
* Computes an option value for a TCP socket based channel, or a list of
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index f343f82..2703309 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -191,6 +191,9 @@ struct TcpState {
* flag indicates that reentry is
* still pending */
#define TCP_ASYNC_FAILED (1<<5) /* An async connect finally failed */
+#define TCP_ASYNC_TEST_MODE (1<<6) /* Async testing activated
+ * Do not automatically continue connection
+ * process */
/*
* The following structure is what is added to the Tcl event queue when a
@@ -602,6 +605,20 @@ WaitForConnect(
}
/*
+ * In socket test mode do not continue with the connect
+ * Exceptions are:
+ * - Call by recv/send and blocking socket
+ * (errorCodePtr != NULL && ! flags & TCP_NONBLOCKING)
+ * - Call by the event queue (errorCodePtr == NULL)
+ */
+
+ if ( (statePtr->flags & TCP_ASYNC_TEST_MODE)
+ && errorCodePtr != NULL && (statePtr->flags & TCP_NONBLOCKING)) {
+ *errorCodePtr = EWOULDBLOCK;
+ return -1;
+ }
+
+ /*
* Be sure to disable event servicing so we are truly modal.
*/
@@ -1123,6 +1140,7 @@ TcpSetOptionProc(
const char *optionName, /* Name of the option to set. */
const char *value) /* New value for option. */
{
+ TcpState *statePtr = instanceData;
#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
TcpState *statePtr = instanceData;
SOCKET sock;
@@ -1142,6 +1160,22 @@ TcpSetOptionProc(
return TCL_ERROR;
}
+ /*
+ * Set socket test int value
+ */
+ if (!strcmp(optionName, "-unsupported1")) {
+ int intValue;
+ if (Tcl_GetInt(interp, value, &intValue) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (intValue & 1) {
+ SET_BITS(statePtr->flags,TCP_ASYNC_TEST_MODE);
+ } else {
+ CLEAR_BITS(statePtr->flags,TCP_ASYNC_TEST_MODE);
+ }
+ return TCL_OK;
+ }
+
#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
#error "TCL_FEATURE_KEEPALIVE_NAGLE not reviewed for whether to treat statePtr->sockets as single fd or list"
sock = statePtr->sockets->fd;
@@ -1254,7 +1288,9 @@ TcpGetOptionProc(
* Go one step in async connect
* If any error is thrown save it as backround error to report eventually below
*/
- WaitForConnect(statePtr, NULL);
+ if (! (statePtr->flags & TCP_ASYNC_TEST_MODE) ) {
+ WaitForConnect(statePtr, NULL);
+ }
sock = statePtr->sockets->fd;
if (optionName != NULL) {
generated by cgit v0.12 at 2024-08-22 11:13:05 (GMT)