TIP #468: Support Passing TCP listen Backlog Size Option to TCP Socket Creation

4 files changed, 31 insertions, 20 deletions

diff --git a/generic/tcl.decls b/generic/tcl.decls
index a85c723..994af13 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -714,7 +714,7 @@ declare 198 {
 }
 declare 199 {
     Tcl_Channel Tcl_OpenTcpClient(Tcl_Interp *interp, int port,
-	    const char *address, const char *myaddr, int myport, int async)
+	    const char *address, const char *myaddr, int myport, int flags)
 }
 declare 200 {
     Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port,
@@ -2327,11 +2327,11 @@ declare 630 {
 
 # ----- BASELINE -- FOR -- 8.6.0 ----- #
 
-# TIP #456
+# TIP #456/#468
 declare 631 {
     Tcl_Channel Tcl_OpenTcpServerEx(Tcl_Interp *interp, const char *service,
-	    const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc,
-	    void *callbackData)
+	    const char *host, unsigned int flags, int backlog,
+	    Tcl_TcpAcceptProc *acceptProc, void *callbackData)
 }
 
 # TIP #430
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index d1af7be..a7d3023 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -1878,7 +1878,7 @@ EXTERN void		Tcl_ZlibStreamSetCompressionDictionary(
 /* 631 */
 EXTERN Tcl_Channel	Tcl_OpenTcpServerEx(Tcl_Interp *interp,
 				const char *service, const char *host,
-				unsigned int flags,
+				unsigned int flags, int backlog,
 				Tcl_TcpAcceptProc *acceptProc,
 				void *callbackData);
 /* 632 */
@@ -2704,7 +2704,7 @@ typedef struct TclStubs {
     void * (*tcl_FindSymbol) (Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 628 */
     int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */
     void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */
-    Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, void *callbackData); /* 631 */
+    Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, int backlog, Tcl_TcpAcceptProc *acceptProc, void *callbackData); /* 631 */
     int (*tclZipfs_Mount) (Tcl_Interp *interp, const char *mountPoint, const char *zipname, const char *passwd); /* 632 */
     int (*tclZipfs_Unmount) (Tcl_Interp *interp, const char *mountPoint); /* 633 */
     Tcl_Obj * (*tclZipfs_TclLibrary) (void); /* 634 */
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 2ab31e4..0ea84f1 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -1467,15 +1467,15 @@ Tcl_SocketObjCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     static const char *const socketOptions[] = {
-	"-async", "-myaddr", "-myport", "-reuseaddr", "-reuseport", "-server",
-	NULL
+	"-async", "-backlog", "-myaddr", "-myport", "-reuseaddr",
+	"-reuseport", "-server", NULL
     };
     enum socketOptionsEnum {
-	SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_REUSEADDR, SKT_REUSEPORT,
-	SKT_SERVER
+	SKT_ASYNC, SKT_BACKLOG, SKT_MYADDR, SKT_MYPORT, SKT_REUSEADDR,
+	SKT_REUSEPORT, SKT_SERVER
     };
     int optionIndex, a, server = 0, myport = 0, async = 0, reusep = -1,
-	reusea = -1;
+	reusea = -1, backlog = -1;
     unsigned int flags = 0;
     const char *host, *port, *myaddr = NULL;
     Tcl_Obj *script = NULL;
@@ -1565,6 +1565,17 @@ Tcl_SocketObjCmd(
 		return TCL_ERROR;
 	    }
 	    break;
+	case SKT_BACKLOG:
+	    a++;
+	    if (a >= objc) {
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"no argument given for -backlog option", -1));
+		return TCL_ERROR;
+	    }
+	    if (Tcl_GetIntFromObj(interp, objv[a], &backlog) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    break;
 	default:
 	    Tcl_Panic("Tcl_SocketObjCmd: bad option index to SocketOptions");
 	}
@@ -1585,18 +1596,18 @@ Tcl_SocketObjCmd(
     wrongNumArgs:
 	iPtr = (Interp *) interp;
 	Tcl_WrongNumArgs(interp, 1, objv,
-		"?-myaddr addr? ?-myport myport? ?-async? host port");
+		"?-async? ?-myaddr addr? ?-myport myport? host port");
 	iPtr->flags |= INTERP_ALTERNATE_WRONG_ARGS;
 	Tcl_WrongNumArgs(interp, 1, objv,
-		"-server command ?-reuseaddr boolean? ?-reuseport boolean? "
-		"?-myaddr addr? port");
+		"-server command ?-backlog count? ?-myaddr addr? "
+		"?-reuseaddr boolean? ?-reuseport boolean? port");
 	return TCL_ERROR;
     }
 
-    if (!server && (reusea != -1 || reusep != -1)) {
+    if (!server && (reusea != -1 || reusep != -1 || backlog != -1)) {
 	Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		"options -reuseaddr and -reuseport are only valid for servers",
-		-1));
+		"options -backlog, -reuseaddr, and -reuseport are only valid "
+		"for servers", -1));
 	return TCL_ERROR;
     }
 
@@ -1641,7 +1652,7 @@ Tcl_SocketObjCmd(
 	acceptCallbackPtr->script = script;
 	acceptCallbackPtr->interp = interp;
 
-	chan = Tcl_OpenTcpServerEx(interp, port, host, flags,
+	chan = Tcl_OpenTcpServerEx(interp, port, host, flags, backlog,
 		AcceptCallbackProc, acceptCallbackPtr);
 	if (chan == NULL) {
 	    Tcl_DecrRefCount(script);
diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c
index 87a79db..eaa9cc8 100644
--- a/generic/tclIOSock.c
+++ b/generic/tclIOSock.c
@@ -318,8 +318,8 @@ Tcl_OpenTcpServer(
     char portbuf[TCL_INTEGER_SPACE];
 
     TclFormatInt(portbuf, port);
-    return Tcl_OpenTcpServerEx(interp, portbuf, host, TCL_TCPSERVER_REUSEADDR,
-	    acceptProc, callbackData);
+    return Tcl_OpenTcpServerEx(interp, portbuf, host, -1,
+	    TCL_TCPSERVER_REUSEADDR, acceptProc, callbackData);
 }
 
 /*