diff options
| -rw-r--r-- | generic/tcl.decls | 4 | ||||
| -rw-r--r-- | generic/tclIOCmd.c | 31 | ||||
| -rw-r--r-- | generic/tclIOSock.c | 4 | ||||
| -rw-r--r-- | unix/tclUnixSock.c | 6 | ||||
| -rw-r--r-- | win/tclWinSock.c | 7 |
5 files changed, 36 insertions, 16 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls index b2b91a9..c7ca44f 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2329,8 +2329,8 @@ declare 630 { # TIP #456 declare 631 { Tcl_Channel Tcl_OpenTcpServerEx(Tcl_Interp *interp, const char *service, - const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, - ClientData callbackData) + const char *host, unsigned int flags, int backlog, + Tcl_TcpAcceptProc *acceptProc, ClientData callbackData) } # ----- BASELINE -- FOR -- 8.7.0 ----- # diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index e52200d..712f773 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -1485,15 +1485,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 socketOptions { - 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; @@ -1583,6 +1583,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"); } @@ -1607,14 +1618,14 @@ Tcl_SocketObjCmd( iPtr->flags |= INTERP_ALTERNATE_WRONG_ARGS; Tcl_WrongNumArgs(interp, 1, objv, "-server command ?-reuseaddr boolean? ?-reuseport boolean? " - "?-myaddr addr? port"); + "?-myaddr addr? ?-backlog count? 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; } @@ -1659,7 +1670,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 82d2fc1..5038775 100644 --- a/generic/tclIOSock.c +++ b/generic/tclIOSock.c @@ -317,8 +317,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); } /* diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c index a64157e..95e134b 100644 --- a/unix/tclUnixSock.c +++ b/unix/tclUnixSock.c @@ -1465,6 +1465,7 @@ Tcl_OpenTcpServerEx( 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. */ @@ -1630,7 +1631,10 @@ Tcl_OpenTcpServerEx( 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; diff --git a/win/tclWinSock.c b/win/tclWinSock.c index d6aca1b..e42cafd 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -2161,6 +2161,8 @@ Tcl_OpenTcpServerEx( 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. */ @@ -2283,7 +2285,10 @@ Tcl_OpenTcpServerEx( * 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) { TclWinConvertError((DWORD) WSAGetLastError()); closesocket(sock); continue; |