Tcl Source Code

Artifact [d171478c83]
Login

Artifact d171478c834c1e5b6bd2bbaf74a0194c15abe8fa2ba36185e40b8454419c82c0:

Attachment "tip344.patch" to ticket [654a2ff6a0] added by chw 2022-09-02 21:21:46.
Index: doc/socket.n
==================================================================
--- doc/socket.n
+++ doc/socket.n
@@ -160,11 +160,12 @@
 \fBchan configure\fR command to retrieve the \fB\-sockname\fR option as
 described below.
 .SH "CONFIGURATION OPTIONS"
 .PP
 The \fBchan configure\fR command can be used to query several readonly
-configuration options for socket channels:
+configuration options for socket channels or in some cases to set
+alternative properties on socket channels:
 .TP
 \fB\-error\fR
 .
 This option gets the current error status of the given socket.  This
 is useful when you need to determine if an asynchronous connect
@@ -202,10 +203,22 @@
 list is identical to the address, its first element.
 .TP
 \fB\-connecting\fR
 .
 This option is not supported by server sockets. For client sockets, this option returns 1 if an asyncroneous connect is still in progress, 0 otherwise.
+.TP
+\fB\-keepalive\fR
+.
+This options sets or queries the TCP keepalive option on the socket as 1 if
+keepalive is turned on, 0 otherwise.
+.TP
+\fB\-nagle\fR
+.
+This options sets or queries the TCP nodelay option (aka the Nagle algorithm)
+When 1 the Nagle algorithm is turned on, 0 otherwise. Caution: the logic is
+reversed here, i.e. when the option is 0, the underlying system call asserts
+the TCP_NODELAY setting.
 .PP
 .SH "EXAMPLES"
 .PP
 Here is a very simple time server:
 .PP

Index: tests/ioCmd.test
==================================================================
--- tests/ioCmd.test
+++ tests/ioCmd.test
@@ -304,11 +304,11 @@
 } -cleanup {
     close $cli
     close $srv
     unset cli srv port
     rename iocmdSRV {}
-} -returnCodes error -result [expectedOpts "-blah" {-connecting -peername -sockname}]
+} -returnCodes error -result [expectedOpts "-blah" {-connecting -keepalive -peername -nagle -sockname}]
 test iocmd-8.16 {fconfigure command / tcp channel} -constraints socket -setup {
     set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0]
     set port [lindex [fconfigure $srv -sockname] 2]
     proc iocmdSRV {sock ip port} {close $sock}
     set cli [socket 127.0.0.1 $port]

Index: tests/socket.test
==================================================================
--- tests/socket.test
+++ tests/socket.test
@@ -1069,11 +1069,11 @@
     set s [socket -server accept -myaddr $localhost 0]
     set l [fconfigure $s]
     close $s
     update
     llength $l
-} -result 14
+} -result 18
 test socket_$af-7.4 {testing socket specific options} -constraints [list socket supported_$af] -setup {
     set timer [after 10000 "set x timed_out"]
     set l ""
 } -body {
     set s [socket -server accept -myaddr $localhost 0]

Index: unix/tclUnixSock.c
==================================================================
--- unix/tclUnixSock.c
+++ unix/tclUnixSock.c
@@ -7,10 +7,11 @@
  *
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
+#include <netinet/tcp.h>
 #include "tclInt.h"
 
 /*
  * Helper macros to make parts of this file clearer. The macros do exactly
  * what they say on the tin. :-) They also only ever refer to their arguments
@@ -144,10 +145,13 @@
 			    Tcl_DString *dsPtr);
 static int		TcpInputProc(void *instanceData, char *buf,
 			    int toRead, int *errorCode);
 static int		TcpOutputProc(void *instanceData,
 			    const char *buf, int toWrite, int *errorCode);
+static int		TcpSetOptionProc(void *instanceData,
+			    Tcl_Interp *interp, const char *optionName,
+			    const char *value);
 static void		TcpThreadActionProc(void *instanceData, int action);
 static void		TcpWatchProc(void *instanceData, int mask);
 static int		WaitForConnect(TcpState *statePtr, int *errorCodePtr);
 static void		WrapNotify(void *clientData, int mask);
 
@@ -165,11 +169,11 @@
     TCL_CLOSE2PROC,		/* Close proc. */
 #endif
     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. */
     TcpClose2Proc,		/* Close2 proc. */
     TcpBlockModeProc,		/* Set blocking or non-blocking mode.*/
@@ -432,11 +436,11 @@
  * 	0 if the connection has completed, -1 if still in progress or there is
  * 	an error.
  *
  * Side effects:
  *	Processes socket events off the system queue. May process
- *	asynchroneous connects.
+ *	asynchronous connects.
  *
  *----------------------------------------------------------------------
  */
 
 static int
@@ -813,10 +817,92 @@
 }
 
 /*
  *----------------------------------------------------------------------
  *
+ * 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(
+    void *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 = (TcpState *)instanceData;
+    size_t len = 0;
+
+    if (optionName != NULL) {
+	len = strlen(optionName);
+    }
+
+    if ((len > 1) && (optionName[1] == 'k') &&
+	    (strncmp(optionName, "-keepalive", len) == 0)) {
+	int val = 0, ret;
+
+	if (Tcl_GetBoolean(interp, value, &val) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+#if defined(SO_KEEPALIVE)
+	ret = setsockopt(statePtr->fds.fd, SOL_SOCKET, SO_KEEPALIVE,
+		(const char *) &val, sizeof(int));
+#else
+	ret = -1;
+	Tcl_SetErrno(ENOTSUP);
+#endif
+	if (ret < 0) {
+	    if (interp) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"couldn't set socket option: %s",
+			Tcl_PosixError(interp)));
+	    }
+	    return TCL_ERROR;
+	}
+	return TCL_OK;
+    }
+    if ((len > 1) && (optionName[1] == 'n') &&
+	    (strncmp(optionName, "-nagle", len) == 0)) {
+	int val = 0, ret;
+
+	if (Tcl_GetBoolean(interp, value, &val) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	val = !val;	/* Nagle ain't nodelay */
+#if defined(SOL_TCP) && defined(TCP_NODELAY)
+	ret = setsockopt(statePtr->fds.fd, SOL_TCP, TCP_NODELAY,
+		(const char *) &val, sizeof(int));
+#else
+	ret = -1;
+	Tcl_SetErrno(ENOTSUP);
+#endif
+	if (ret < 0) {
+	    if (interp) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"couldn't set socket option: %s",
+			Tcl_PosixError(interp)));
+	    }
+	    return TCL_ERROR;
+	}
+	return TCL_OK;
+    }
+    return Tcl_BadChannelOption(interp, optionName, "keepalive nagle");
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TcpGetOptionProc --
  *
  *	Computes an option value for a TCP socket based channel, or a list of
  *	all options and their values.
  *
@@ -833,11 +919,11 @@
  *----------------------------------------------------------------------
  */
 
 static int
 TcpGetOptionProc(
-    void *instanceData,	/* Socket state. */
+    void *instanceData,		/* Socket state. */
     Tcl_Interp *interp,		/* For error reporting - can be NULL. */
     const char *optionName,	/* Name of the option to retrieve the value
 				 * for, or NULL to get all options and their
 				 * values. */
     Tcl_DString *dsPtr)		/* Where to store the computed value;
@@ -844,20 +930,19 @@
 				 * initialized by caller. */
 {
     TcpState *statePtr = (TcpState *)instanceData;
     size_t len = 0;
 
-    WaitForConnect(statePtr, NULL);
-
     if (optionName != NULL) {
 	len = strlen(optionName);
     }
 
     if ((len > 1) && (optionName[1] == 'e') &&
 	    (strncmp(optionName, "-error", len) == 0)) {
 	socklen_t optlen = sizeof(int);
 
+	WaitForConnect(statePtr, NULL);
         if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) {
             /*
              * Suppress errors as long as we are not done.
              */
 
@@ -878,10 +963,11 @@
 	return TCL_OK;
     }
 
     if ((len > 1) && (optionName[1] == 'c') &&
 	    (strncmp(optionName, "-connecting", len) == 0)) {
+	WaitForConnect(statePtr, NULL);
         Tcl_DStringAppend(dsPtr,
                 GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT) ? "1" : "0", TCL_INDEX_NONE);
         return TCL_OK;
     }
 
@@ -888,10 +974,11 @@
     if ((len == 0) || ((len > 1) && (optionName[1] == 'p') &&
 	    (strncmp(optionName, "-peername", len) == 0))) {
         address peername;
         socklen_t size = sizeof(peername);
 
+	WaitForConnect(statePtr, NULL);
 	if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) {
 	    /*
 	     * In async connect output an empty string
 	     */
 
@@ -939,10 +1026,11 @@
 	TcpFdList *fds;
         address sockname;
         socklen_t size;
 	int found = 0;
 
+	WaitForConnect(statePtr, NULL);
 	if (len == 0) {
 	    Tcl_DStringAppendElement(dsPtr, "-sockname");
 	    Tcl_DStringStartSublist(dsPtr);
 	}
 	if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) {
@@ -971,14 +1059,51 @@
                         "can't get sockname: %s", Tcl_PosixError(interp)));
             }
 	    return TCL_ERROR;
 	}
     }
+
+    if ((len == 0) || ((len > 1) && (optionName[1] == 'k') &&
+	    (strncmp(optionName, "-keepalive", len) == 0))) {
+        socklen_t size;
+	int opt = 0;
+
+	if (len == 0) {
+	    Tcl_DStringAppendElement(dsPtr, "-keepalive");
+	}
+#if defined(SO_KEEPALIVE)
+	getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_KEEPALIVE,
+		(char *) &opt, &size);
+#endif
+	Tcl_DStringAppendElement(dsPtr, opt ? "1" : "0");
+	if (len > 0) {
+	    return TCL_OK;
+	}
+    }
+
+    if ((len == 0) || ((len > 1) && (optionName[1] == 'n') &&
+	    (strncmp(optionName, "-nagle", len) == 0))) {
+        socklen_t size;
+	int opt = 0;
+
+	if (len == 0) {
+	    Tcl_DStringAppendElement(dsPtr, "-nagle");
+	}
+#if defined(SOL_TCP) && defined(TCP_NODELAY)
+	getsockopt(statePtr->fds.fd, SOL_TCP, TCP_NODELAY,
+		(char *) &opt, &size);
+#endif
+	opt = !opt;	/* Nagle ain't nodelay */
+	Tcl_DStringAppendElement(dsPtr, opt ? "1" : "0");
+	if (len > 0) {
+	    return TCL_OK;
+	}
+    }
 
     if (len > 0) {
 	return Tcl_BadChannelOption(interp, optionName,
-                "connecting peername sockname");
+                "connecting keepalive nagle peername sockname");
     }
 
     return TCL_OK;
 }
 
@@ -1349,11 +1474,11 @@
         if (error != 0) {
             SET_BITS(statePtr->flags, TCP_ASYNC_FAILED);
         }
 
         /*
-         * We need to forward the writable event that brought us here, bcasue
+         * We need to forward the writable event that brought us here, because
          * upon reading of getsockopt(SO_ERROR), at least some OSes clear the
          * writable state from the socket, and so a subsequent select() on
          * behalf of a script level [fileevent] would not fire. It doesn't
          * hurt that this is also called in the successful case and will save
          * the event mechanism one roundtrip through select().

Index: win/tclWinSock.c
==================================================================
--- win/tclWinSock.c
+++ win/tclWinSock.c
@@ -52,17 +52,10 @@
 
 #ifdef _MSC_VER
 #   pragma comment (lib, "ws2_32")
 #endif
 
-/*
- * Support for control over sockets' KEEPALIVE and NODELAY behavior is
- * currently disabled.
- */
-
-#undef TCL_FEATURE_KEEPALIVE_NAGLE
-
 /*
  * Helper macros to make parts of this file clearer. The macros do exactly
  * what they say on the tin. :-) They also only ever refer to their arguments
  * once, and so can be used without regard to side effects.
  */
@@ -587,11 +580,11 @@
  * 	0 if the connection has completed, -1 if still in progress or there is
  * 	an error.
  *
  * Side effects:
  *	Processes socket events off the system queue. May process
- *	asynchroneous connect.
+ *	asynchronous connect.
  *
  *----------------------------------------------------------------------
  */
 
 static int
@@ -1183,18 +1176,19 @@
 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. */
-    TCL_UNUSED(const char *) /*value*/)		/* New value for option. */
+    const char *value)		/* New value for option. */
 {
-#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
-    TcpState *statePtr = instanceData;
+    TcpState *statePtr = (TcpState *)instanceData;
     SOCKET sock;
-#else
-    (void)instanceData;
-#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
+    size_t len = 0;
+
+    if (optionName != NULL) {
+	len = strlen(optionName);
+    }
 
     /*
      * Check that WinSock is initialized; do not call it if not, to prevent
      * system crashes. This can happen at exit time if the exit handler for
      * WinSock ran before other exit handlers that want to use sockets.
@@ -1206,24 +1200,21 @@
 		    "winsock is not initialized", -1));
 	}
 	return TCL_ERROR;
     }
 
-#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;
 
-    if (!strcasecmp(optionName, "-keepalive")) {
-	BOOL val = FALSE;
+    if ((len > 1) && (optionName[1] == 'k') &&
+	    (strncmp(optionName, "-keepalive", len) == 0)) {
+	BOOL val;
 	int boolVar, rtn;
 
 	if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	if (boolVar) {
-	    val = TRUE;
-	}
+	val = boolVar ? TRUE : FALSE;
 	rtn = setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE,
 		(const char *) &val, sizeof(BOOL));
 	if (rtn != 0) {
 	    Tcl_WinConvertError(WSAGetLastError());
 	    if (interp) {
@@ -1232,20 +1223,20 @@
 			Tcl_PosixError(interp)));
 	    }
 	    return TCL_ERROR;
 	}
 	return TCL_OK;
-    } else if (!strcasecmp(optionName, "-nagle")) {
-	BOOL val = FALSE;
+    }
+    if ((len > 1) && (optionName[1] == 'n') &&
+	(strncmp(optionName, "-nagle", len) == 0)) {
+	BOOL val;
 	int boolVar, rtn;
 
 	if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	if (!boolVar) {
-	    val = TRUE;
-	}
+	val = boolVar ? FALSE : TRUE;
 	rtn = setsockopt(sock, IPPROTO_TCP, TCP_NODELAY,
 		(const char *) &val, sizeof(BOOL));
 	if (rtn != 0) {
 	    Tcl_WinConvertError(WSAGetLastError());
 	    if (interp) {
@@ -1255,15 +1246,11 @@
 	    }
 	    return TCL_ERROR;
 	}
 	return TCL_OK;
     }
-
     return Tcl_BadChannelOption(interp, optionName, "keepalive nagle");
-#else
-    return Tcl_BadChannelOption(interp, optionName, "");
-#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
 }
 
 /*
  *----------------------------------------------------------------------
  *
@@ -1534,58 +1521,47 @@
 	    }
 	    return TCL_ERROR;
 	}
     }
 
-#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
-    if (len == 0 || !strncmp(optionName, "-keepalive", len)) {
+    if ((len == 0) || ((len > 1) && (optionName[1] == 'k') &&
+	    (strncmp(optionName, "-keepalive", len) == 0))) {
 	int optlen;
 	BOOL opt = FALSE;
 
 	if (len == 0) {
+	    sock = statePtr->sockets->fd;
 	    Tcl_DStringAppendElement(dsPtr, "-keepalive");
 	}
 	optlen = sizeof(BOOL);
 	getsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, (char *)&opt, &optlen);
-	if (opt) {
-	    Tcl_DStringAppendElement(dsPtr, "1");
-	} else {
-	    Tcl_DStringAppendElement(dsPtr, "0");
+	Tcl_DStringAppendElement(dsPtr, opt ? "1" : "0");
+	if (len > 0) {
+	    return TCL_OK;
 	}
+    }
+
+    if ((len == 0) || ((len > 1) && (optionName[1] == 'n') &&
+	    (strncmp(optionName, "-nagle", len) == 0))) {
+	int optlen;
+	BOOL opt = FALSE;
+
+	if (len == 0) {
+	    sock = statePtr->sockets->fd;
+	    Tcl_DStringAppendElement(dsPtr, "-nagle");
+	}
+	optlen = sizeof(BOOL);
+	getsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&opt, &optlen);
+	Tcl_DStringAppendElement(dsPtr, opt ? "0" : "1");
 	if (len > 0) {
 	    return TCL_OK;
 	}
     }
 
-    if (len == 0 || !strncmp(optionName, "-nagle", len)) {
-	int optlen;
-	BOOL opt = FALSE;
-
-	if (len == 0) {
-	    Tcl_DStringAppendElement(dsPtr, "-nagle");
-	}
-	optlen = sizeof(BOOL);
-	getsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&opt, &optlen);
-	if (opt) {
-	    Tcl_DStringAppendElement(dsPtr, "0");
-	} else {
-	    Tcl_DStringAppendElement(dsPtr, "1");
-	}
-	if (len > 0) {
-	    return TCL_OK;
-	}
-    }
-#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
-
     if (len > 0) {
-#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
 	return Tcl_BadChannelOption(interp, optionName,
-		"connecting peername sockname keepalive nagle");
-#else
-	return Tcl_BadChannelOption(interp, optionName,
-                "connecting peername sockname");
-#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
+		"connecting keepalive nagle peername sockname");
     }
 
     return TCL_OK;
 }
 
@@ -1670,12 +1646,10 @@
     TcpState *statePtr = (TcpState *)instanceData;
 
     *handlePtr = INT2PTR(statePtr->sockets->fd);
     return TCL_OK;
 }
-
-
 
 /*
  *----------------------------------------------------------------------
  *
  * TcpConnect --
@@ -1808,11 +1782,11 @@
 		Tcl_WinConvertError((DWORD) WSAGetLastError());
 		continue;
 	    }
 
 	    /*
-	     * For asynchroneous connect set the socket in nonblocking mode
+	     * For asynchronous connect set the socket in nonblocking mode
 	     * and activate connect notification
 	     */
 
 	    if (async_connect) {
 		TcpState *statePtr2;
@@ -1923,11 +1897,11 @@
 		SetEvent(tsdPtr->socketListLock);
 	    }
 
 	    /*
 	     * Clear the tsd socket list pointer if we did not wait for
-	     * the FD_CONNECT asynchroneously
+	     * the FD_CONNECT asynchronously
 	     */
 
 	    tsdPtr->pendingTcpState = NULL;
 
 	    if (Tcl_GetErrno() == 0) {