summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--generic/tcl.decls4
-rw-r--r--generic/tclIOCmd.c36
-rw-r--r--generic/tclIOSock.c5
-rw-r--r--unix/tclUnixSock.c6
-rw-r--r--win/tclWinSock.c7
5 files changed, 38 insertions, 20 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 1bd3fe7..55685e3 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;
}
@@ -1638,15 +1649,14 @@ Tcl_SocketObjCmd(
port = TclGetString(objv[a]);
if (server) {
- AcceptCallback *acceptCallbackPtr =
- ckalloc(sizeof(AcceptCallback));
+ AcceptCallback *acceptCallbackPtr = ckalloc(sizeof(AcceptCallback));
Tcl_IncrRefCount(script);
acceptCallbackPtr->script = script;
acceptCallbackPtr->interp = interp;
- chan = Tcl_OpenTcpServerEx(interp, port, host, flags, AcceptCallbackProc,
- acceptCallbackPtr);
+ chan = Tcl_OpenTcpServerEx(interp, port, host, flags, backlog,
+ AcceptCallbackProc, acceptCallbackPtr);
if (chan == NULL) {
Tcl_DecrRefCount(script);
ckfree(acceptCallbackPtr);
diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c
index 8ad268a..858c58e 100644
--- a/generic/tclIOSock.c
+++ b/generic/tclIOSock.c
@@ -307,9 +307,8 @@ Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port,
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 9387d05..1e80799 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -1425,6 +1425,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. */
@@ -1584,7 +1585,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 81a5449..a580a8d 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -2040,6 +2040,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. */
@@ -2160,7 +2162,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;