summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/OpenTcp.34
-rw-r--r--generic/tcl.decls8
-rw-r--r--generic/tclDecls.h4
-rw-r--r--generic/tclIOCmd.c35
-rw-r--r--generic/tclIOSock.c4
-rw-r--r--tests/socket.test20
-rw-r--r--unix/tclUnixSock.c6
-rw-r--r--win/tclWinSock.c7
8 files changed, 55 insertions, 33 deletions
diff --git a/doc/OpenTcp.3 b/doc/OpenTcp.3
index 5b941dc..ca26b59 100644
--- a/doc/OpenTcp.3
+++ b/doc/OpenTcp.3
@@ -24,7 +24,7 @@ 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
@@ -47,6 +47,8 @@ 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.
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);
}
/*
diff --git a/tests/socket.test b/tests/socket.test
index 7fdb09d..a0fe2f7 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -308,13 +308,13 @@ test socket_$af-1.1 {arg parsing for socket command} -constraints [list socket s
} -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}
@@ -323,19 +323,19 @@ test socket_$af-1.6 {arg parsing for socket command} -constraints [list socket s
} -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"}
@@ -347,19 +347,19 @@ test socket_$af-1.14 {arg parsing for socket command} -constraints [list socket
} -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}
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index 43303f8..4e34af5 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -1673,6 +1673,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. */
@@ -1838,7 +1839,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 3980006..9ac1a15 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -2154,6 +2154,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. */
@@ -2276,7 +2278,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) {
Tcl_WinConvertError((DWORD) WSAGetLastError());
closesocket(sock);
continue;
generated by cgit v0.12 at 2024-11-16 00:05:35 (GMT)