Index: doc/OpenTcp.3 ================================================================== --- doc/OpenTcp.3 +++ doc/OpenTcp.3 @@ -22,11 +22,11 @@ .sp Tcl_Channel \fBTcl_OpenTcpServer\fR(\fIinterp, port, myaddr, proc, clientData\fR) .sp Tcl_Channel -\fBTcl_OpenTcpServerEx\fR(\fIinterp, service, myaddr, flags, proc, clientData\fR) +\fBTcl_OpenTcpServerEx\fR(\fIinterp, service, myaddr, flags, backlog, proc, clientData\fR) .sp .SH ARGUMENTS .AS Tcl_TcpAcceptProc clientData .AP Tcl_Interp *interp in Tcl interpreter to use for error reporting. If non-NULL and an @@ -45,10 +45,12 @@ A string specifying the host name or address for network interface to use for the local end of the connection. If NULL, a default interface is chosen. .AP int async in If nonzero, the client socket is connected asynchronously to the server. +.AP int backlog in +Length of OS listen backlog queue. Use -1 for default value. .AP "unsigned int" flags in ORed combination of \fBTCL_TCPSERVER\fR flags that specify additional informations about the socket being created. .AP ClientData sock in Platform-specific handle for client TCP socket. Index: generic/tcl.decls ================================================================== --- generic/tcl.decls +++ generic/tcl.decls @@ -712,11 +712,11 @@ Tcl_Channel Tcl_OpenFileChannel(Tcl_Interp *interp, const char *fileName, const char *modeString, int permissions) } 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, const char *host, Tcl_TcpAcceptProc *acceptProc, void *callbackData) @@ -2325,15 +2325,15 @@ Tcl_Obj *compressionDictionaryObj) } # ----- 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 declare 632 { int TclZipfs_Mount(Tcl_Interp *interp, const char *mountPoint, Index: generic/tclDecls.h ================================================================== --- generic/tclDecls.h +++ generic/tclDecls.h @@ -1861,11 +1861,11 @@ Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 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 */ EXTERN int TclZipfs_Mount(Tcl_Interp *interp, const char *mountPoint, const char *zipname, @@ -2677,11 +2677,11 @@ int (*tcl_NRSubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 626 */ int (*tcl_LoadFile) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *const symv[], int flags, void *procPtrs, Tcl_LoadHandle *handlePtr); /* 627 */ 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 */ int (*tclZipfs_MountBuffer) (Tcl_Interp *interp, const char *mountPoint, unsigned char *data, size_t datalen, int copy); /* 635 */ void (*tcl_FreeInternalRep) (Tcl_Obj *objPtr); /* 636 */ Index: generic/tclIOCmd.c ================================================================== --- generic/tclIOCmd.c +++ generic/tclIOCmd.c @@ -1465,19 +1465,19 @@ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ 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; Tcl_Channel chan; @@ -1562,10 +1562,21 @@ return TCL_ERROR; } if (Tcl_GetBooleanFromObj(interp, objv[a], &reusep) != TCL_OK) { 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"); } } @@ -1583,22 +1594,22 @@ Interp *iPtr; 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; } /* * Set the options to their default value if the user didn't override @@ -1639,11 +1650,11 @@ Tcl_IncrRefCount(script); 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); ckfree(acceptCallbackPtr); return TCL_ERROR; Index: generic/tclIOSock.c ================================================================== --- generic/tclIOSock.c +++ generic/tclIOSock.c @@ -316,12 +316,12 @@ ClientData callbackData) { 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); } /* * Local Variables: * mode: c Index: tests/socket.test ================================================================== --- tests/socket.test +++ tests/socket.test @@ -306,38 +306,38 @@ test socket_$af-1.1 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -server } -returnCodes error -result {no argument given for -server option} test socket_$af-1.2 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -server foo -} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-reuseaddr boolean? ?-reuseport boolean? ?-myaddr addr? port"} +} -returnCodes error -result {wrong # args: should be "socket ?-async? ?-myaddr addr? ?-myport myport? host port" or "socket -server command ?-backlog count? ?-myaddr addr? ?-reuseaddr boolean? ?-reuseport boolean? port"} test socket_$af-1.3 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -myaddr } -returnCodes error -result {no argument given for -myaddr option} test socket_$af-1.4 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -myaddr $localhost -} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-reuseaddr boolean? ?-reuseport boolean? ?-myaddr addr? port"} +} -returnCodes error -result {wrong # args: should be "socket ?-async? ?-myaddr addr? ?-myport myport? host port" or "socket -server command ?-backlog count? ?-myaddr addr? ?-reuseaddr boolean? ?-reuseport boolean? port"} test socket_$af-1.5 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -myport } -returnCodes error -result {no argument given for -myport option} test socket_$af-1.6 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -myport xxxx } -returnCodes error -result {expected integer but got "xxxx"} test socket_$af-1.7 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -myport 2522 -} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-reuseaddr boolean? ?-reuseport boolean? ?-myaddr addr? port"} +} -returnCodes error -result {wrong # args: should be "socket ?-async? ?-myaddr addr? ?-myport myport? host port" or "socket -server command ?-backlog count? ?-myaddr addr? ?-reuseaddr boolean? ?-reuseport boolean? port"} test socket_$af-1.8 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -froboz -} -returnCodes error -result {bad option "-froboz": must be -async, -myaddr, -myport, -reuseaddr, -reuseport, or -server} +} -returnCodes error -result {bad option "-froboz": must be -async, -backlog, -myaddr, -myport, -reuseaddr, -reuseport, or -server} test socket_$af-1.9 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -server foo -myport 2521 3333 } -returnCodes error -result {option -myport is not valid for servers} test socket_$af-1.10 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket host 2528 -junk -} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-reuseaddr boolean? ?-reuseport boolean? ?-myaddr addr? port"} +} -returnCodes error -result {wrong # args: should be "socket ?-async? ?-myaddr addr? ?-myport myport? host port" or "socket -server command ?-backlog count? ?-myaddr addr? ?-reuseaddr boolean? ?-reuseport boolean? port"} test socket_$af-1.11 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -server callback 2520 -- -} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-reuseaddr boolean? ?-reuseport boolean? ?-myaddr addr? port"} +} -returnCodes error -result {wrong # args: should be "socket ?-async? ?-myaddr addr? ?-myport myport? host port" or "socket -server command ?-backlog count? ?-myaddr addr? ?-reuseaddr boolean? ?-reuseport boolean? port"} test socket_$af-1.12 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket foo badport } -returnCodes error -result {expected integer but got "badport"} test socket_$af-1.13 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -async -server @@ -345,23 +345,23 @@ test socket_$af-1.14 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -server foo -async } -returnCodes error -result {cannot set -async option for server sockets} test socket_$af-1.15 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -reuseaddr yes 4242 -} -returnCodes error -result {options -reuseaddr and -reuseport are only valid for servers} +} -returnCodes error -result {options -backlog, -reuseaddr, and -reuseport are only valid for servers} test socket_$af-1.16 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -reuseaddr no 4242 -} -returnCodes error -result {options -reuseaddr and -reuseport are only valid for servers} +} -returnCodes error -result {options -backlog, -reuseaddr, and -reuseport are only valid for servers} test socket_$af-1.17 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -reuseaddr } -returnCodes error -result {no argument given for -reuseaddr option} test socket_$af-1.18 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -reuseport yes 4242 -} -returnCodes error -result {options -reuseaddr and -reuseport are only valid for servers} +} -returnCodes error -result {options -backlog, -reuseaddr, and -reuseport are only valid for servers} test socket_$af-1.19 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -reuseport no 4242 -} -returnCodes error -result {options -reuseaddr and -reuseport are only valid for servers} +} -returnCodes error -result {options -backlog, -reuseaddr, and -reuseport are only valid for servers} test socket_$af-1.20 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -reuseport } -returnCodes error -result {no argument given for -reuseport option} set path(script) [makeFile {} script] Index: unix/tclUnixSock.c ================================================================== --- unix/tclUnixSock.c +++ unix/tclUnixSock.c @@ -1667,10 +1667,11 @@ Tcl_OpenTcpServerEx( Tcl_Interp *interp, /* For error reporting - may be NULL. */ const char *service, /* Port number to open. */ const char *myHost, /* Name of local host. */ unsigned int flags, /* Flags. */ + int backlog, /* Length of OS listen backlog queue. */ Tcl_TcpAcceptProc *acceptProc, /* Callback for accepting connections from new * clients. */ void *acceptProcData) /* Data for the callback. */ { @@ -1832,11 +1833,14 @@ if (getsockname(sock, &sockname.sa, &namelen) >= 0) { chosenport = ntohs(sockname.sa4.sin_port); } } - status = listen(sock, SOMAXCONN); + if (backlog < 0) { + backlog = SOMAXCONN; + } + status = listen(sock, backlog); if (status < 0) { if (howfar < LISTEN) { howfar = LISTEN; my_errno = errno; } Index: win/tclWinSock.c ================================================================== --- win/tclWinSock.c +++ win/tclWinSock.c @@ -2154,10 +2154,12 @@ Tcl_OpenTcpServerEx( Tcl_Interp *interp, /* For error reporting - may be NULL. */ const char *service, /* Port number to open. */ const char *myHost, /* Name of local host. */ unsigned int flags, /* Flags. */ + int backlog, /* Length of OS listen backlog queue, or -1 + * for default. */ Tcl_TcpAcceptProc *acceptProc, /* Callback for accepting connections from new * clients. */ void *acceptProcData) /* Data for the callback. */ { @@ -2276,11 +2278,14 @@ * Set the maximum number of pending connect requests to the max * value allowed on each platform (Win32 and Win32s may be * different, and there may be differences between TCP/IP stacks). */ - if (listen(sock, SOMAXCONN) == SOCKET_ERROR) { + if (backlog < 0) { + backlog = SOMAXCONN; + } + if (listen(sock, backlog) == SOCKET_ERROR) { Tcl_WinConvertError((DWORD) WSAGetLastError()); closesocket(sock); continue; }