summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--doc/OpenTcp.318
-rw-r--r--doc/socket.n10
-rw-r--r--generic/tcl.decls11
-rw-r--r--generic/tcl.h7
-rw-r--r--generic/tclBinary.c8
-rw-r--r--generic/tclDecls.h9
-rw-r--r--generic/tclIOCmd.c79
-rw-r--r--generic/tclIOSock.c28
-rw-r--r--generic/tclStubInit.c1
-rw-r--r--tests/socket.test43
-rw-r--r--unix/tclUnixSock.c39
-rw-r--r--win/tclWinSock.c27
12 files changed, 240 insertions, 40 deletions
diff --git a/doc/OpenTcp.3 b/doc/OpenTcp.3
index 4a7dc1e..5b941dc 100644
--- a/doc/OpenTcp.3
+++ b/doc/OpenTcp.3
@@ -4,12 +4,12 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-.TH Tcl_OpenTcpClient 3 8.0 Tcl "Tcl Library Procedures"
+.TH Tcl_OpenTcpClient 3 8.7 Tcl "Tcl Library Procedures"
.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
-Tcl_OpenTcpClient, Tcl_MakeTcpClientChannel, Tcl_OpenTcpServer \- procedures to open channels using TCP sockets
+Tcl_OpenTcpClient, Tcl_MakeTcpClientChannel, Tcl_OpenTcpServer, Tcl_OpenTcpServerEx \- procedures to open channels using TCP sockets
.SH SYNOPSIS
.nf
\fB#include <tcl.h> \fR
@@ -23,6 +23,9 @@ Tcl_Channel
Tcl_Channel
\fBTcl_OpenTcpServer\fR(\fIinterp, port, myaddr, proc, clientData\fR)
.sp
+Tcl_Channel
+\fBTcl_OpenTcpServerEx\fR(\fIinterp, service, myaddr, flags, proc, clientData\fR)
+.sp
.SH ARGUMENTS
.AS Tcl_TcpAcceptProc clientData
.AP Tcl_Interp *interp in
@@ -30,6 +33,9 @@ Tcl interpreter to use for error reporting. If non-NULL and an
error occurs, an error message is left in the interpreter's result.
.AP int port in
A port number to connect to as a client or to listen on as a server.
+.AP "const char" *service in
+A string specifying the port number to connect to as a client or to listen on as
+ a server.
.AP "const char" *host in
A string specifying a host name or address for the remote end of the connection.
.AP int myport in
@@ -41,6 +47,9 @@ 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 "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.
.AP Tcl_TcpAcceptProc *proc in
@@ -158,6 +167,11 @@ register it, use \fBTcl_RegisterChannel\fR.
If one of the standard channels, \fBstdin\fR, \fBstdout\fR or \fBstderr\fR was
previously closed, the act of creating the new channel also assigns it as a
replacement for the standard channel.
+.SS TCL_OPENTCPSERVEREX
+.PP
+\fBTcl_OpenTcpServerEx\fR behaviour is identical to \fBTcl_OpenTcpServer\fR but
+gives more flexibility to the user by providing a mean to further customize some
+aspects of the socket via the \fIflags\fR parameter.
.SH "PLATFORM ISSUES"
.PP
On Unix platforms, the socket handle is a Unix file descriptor as
diff --git a/doc/socket.n b/doc/socket.n
index 3efdb37..823dbd5 100644
--- a/doc/socket.n
+++ b/doc/socket.n
@@ -131,6 +131,16 @@ wildcard address so that it can accept connections from any
interface. If \fIaddr\fR is a domain name that resolves to multiple IP
addresses that are available on the local machine, the socket will
listen on all of them.
+.TP
+\fB\-reuseaddr\fI boolean\fR
+.
+Tells the kernel whether to reuse the local address if there is no socket
+actively listening on it. This is the default on Windows.
+.TP
+\fB\-reuseport\fI boolean\fR
+.
+Tells the kernel whether to allow the binding of multiple sockets to the same
+address and port.
.PP
Server channels cannot be used for input or output; their sole use is to
accept new client connections. The channels created for each incoming
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 574b49b..ba047a0 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -2326,6 +2326,17 @@ declare 630 {
# ----- BASELINE -- FOR -- 8.6.0 ----- #
+# 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)
+}
+
+# ----- BASELINE -- FOR -- 8.7.0 ----- #
+
+
+
##############################################################################
# Define the platform specific public Tcl interface. These functions are only
diff --git a/generic/tcl.h b/generic/tcl.h
index d1bf47f..c0cee27 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2372,6 +2372,13 @@ typedef int (Tcl_ArgvGenFuncProc)(ClientData clientData, Tcl_Interp *interp,
/*
*----------------------------------------------------------------------------
+ * Definitions needed for the Tcl_OpenTcpServerEx function. [TIP #456]
+ */
+#define TCL_TCPSERVER_REUSEADDR (1<<0)
+#define TCL_TCPSERVER_REUSEPORT (1<<1)
+
+/*
+ *----------------------------------------------------------------------------
* Single public declaration for NRE.
*/
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index f8c07f4..a3e5071 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -172,7 +172,7 @@ static const EnsembleImplMap decodeMap[] = {
* where the codepoint of each character is the value of corresponding byte.
* This approach creates a one-to-one map between all bytearray values
* and a subset of Tcl string values.
- *
+ *
* When converting a Tcl string value to the bytearray internal rep, the
* question arises what to do with strings outside that subset? That is,
* those Tcl strings containing at least one codepoint greater than 255?
@@ -180,7 +180,7 @@ static const EnsembleImplMap decodeMap[] = {
* does not represent any valid bytearray value. Full Stop. The
* setFromAnyProc signature has a completion code return value for just
* this reason, to reject invalid inputs.
- *
+ *
* Unfortunately this was not the path taken by the authors of the
* original tclByteArrayType. They chose to accept all Tcl string values
* as acceptable string encodings of the bytearray values that result
@@ -204,7 +204,7 @@ static const EnsembleImplMap decodeMap[] = {
* unsigned char *Tcl_GetByteArrayFromObj(objPtr, lenPtr)
*
* has a guarantee to always return a non-NULL value, but that value
- * points to a byte sequence that cannot be used by the caller to
+ * points to a byte sequence that cannot be used by the caller to
* process the Tcl value absent some sideband testing that objPtr
* is "pure". Tcl offers no public interface to perform this test,
* so callers either break encapsulation or are unavoidably buggy. Tcl
@@ -218,7 +218,7 @@ static const EnsembleImplMap decodeMap[] = {
* Bytearrays should simply be usable as bytearrays without a kabuki
* dance of testing.
*
- * The Tcl_ObjType "properByteArrayType" is (nearly) a correct
+ * The Tcl_ObjType "properByteArrayType" is (nearly) a correct
* implementation of bytearrays. Any Tcl value with the type
* properByteArrayType can have its bytearray value fetched and
* used with confidence that acting on that value is equivalent to
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index b022d3c..49ac440 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -1816,6 +1816,12 @@ EXTERN int Tcl_FSUnloadFile(Tcl_Interp *interp,
EXTERN void Tcl_ZlibStreamSetCompressionDictionary(
Tcl_ZlibStream zhandle,
Tcl_Obj *compressionDictionaryObj);
+/* 631 */
+EXTERN Tcl_Channel Tcl_OpenTcpServerEx(Tcl_Interp *interp,
+ const char *service, const char *host,
+ unsigned int flags,
+ Tcl_TcpAcceptProc *acceptProc,
+ ClientData callbackData);
typedef struct {
const struct TclPlatStubs *tclPlatStubs;
@@ -2482,6 +2488,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, ClientData callbackData); /* 631 */
} TclStubs;
extern const TclStubs *tclStubsPtr;
@@ -3774,6 +3781,8 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_FSUnloadFile) /* 629 */
#define Tcl_ZlibStreamSetCompressionDictionary \
(tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */
+#define Tcl_OpenTcpServerEx \
+ (tclStubsPtr->tcl_OpenTcpServerEx) /* 631 */
#endif /* defined(USE_TCL_STUBS) */
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index de65da5..1bd3fe7 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -1485,13 +1485,17 @@ Tcl_SocketObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
static const char *const socketOptions[] = {
- "-async", "-myaddr", "-myport", "-server", NULL
+ "-async", "-myaddr", "-myport", "-reuseaddr", "-reuseport", "-server",
+ NULL
};
enum socketOptions {
- SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_SERVER
+ SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_REUSEADDR, SKT_REUSEPORT,
+ SKT_SERVER
};
- int optionIndex, a, server = 0, port, myport = 0, async = 0;
- const char *host, *myaddr = NULL;
+ int optionIndex, a, server = 0, myport = 0, async = 0, reusep = -1,
+ reusea = -1;
+ unsigned int flags = 0;
+ const char *host, *port, *myaddr = NULL;
Tcl_Obj *script = NULL;
Tcl_Channel chan;
@@ -1557,6 +1561,28 @@ Tcl_SocketObjCmd(
}
script = objv[a];
break;
+ case SKT_REUSEADDR:
+ a++;
+ if (a >= objc) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "no argument given for -reuseaddr option", -1));
+ return TCL_ERROR;
+ }
+ if (Tcl_GetBooleanFromObj(interp, objv[a], &reusea) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case SKT_REUSEPORT:
+ a++;
+ if (a >= objc) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "no argument given for -reuseport option", -1));
+ return TCL_ERROR;
+ }
+ if (Tcl_GetBooleanFromObj(interp, objv[a], &reusep) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
default:
Tcl_Panic("Tcl_SocketObjCmd: bad option index to SocketOptions");
}
@@ -1580,19 +1606,37 @@ Tcl_SocketObjCmd(
"?-myaddr addr? ?-myport myport? ?-async? host port");
iPtr->flags |= INTERP_ALTERNATE_WRONG_ARGS;
Tcl_WrongNumArgs(interp, 1, objv,
- "-server command ?-myaddr addr? port");
+ "-server command ?-reuseaddr boolean? ?-reuseport boolean? "
+ "?-myaddr addr? port");
return TCL_ERROR;
}
- if (a == objc-1) {
- if (TclSockGetPort(interp, TclGetString(objv[a]), "tcp",
- &port) != TCL_OK) {
- return TCL_ERROR;
- }
- } else {
+ if (!server && (reusea != -1 || reusep != -1)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "options -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 their
+ // value.
+ if (reusep == -1) reusep = 0;
+ if (reusea == -1) reusea = 1;
+
+ // Build the bitset with the flags values.
+ if (reusea)
+ flags |= TCL_TCPSERVER_REUSEADDR;
+ if (reusep)
+ flags |= TCL_TCPSERVER_REUSEPORT;
+
+ // All the arguments should have been parsed by now, 'a' points to the last
+ // one, the port number.
+ if (a != objc-1) {
goto wrongNumArgs;
}
+ port = TclGetString(objv[a]);
+
if (server) {
AcceptCallback *acceptCallbackPtr =
ckalloc(sizeof(AcceptCallback));
@@ -1600,8 +1644,9 @@ Tcl_SocketObjCmd(
Tcl_IncrRefCount(script);
acceptCallbackPtr->script = script;
acceptCallbackPtr->interp = interp;
- chan = Tcl_OpenTcpServer(interp, port, host, AcceptCallbackProc,
- acceptCallbackPtr);
+
+ chan = Tcl_OpenTcpServerEx(interp, port, host, flags, AcceptCallbackProc,
+ acceptCallbackPtr);
if (chan == NULL) {
Tcl_DecrRefCount(script);
ckfree(acceptCallbackPtr);
@@ -1625,7 +1670,13 @@ Tcl_SocketObjCmd(
Tcl_CreateCloseHandler(chan, TcpServerCloseProc, acceptCallbackPtr);
} else {
- chan = Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async);
+ int portNum;
+
+ if (TclSockGetPort(interp, port, "tcp", &portNum) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ chan = Tcl_OpenTcpClient(interp, portNum, host, myaddr, myport, async);
if (chan == NULL) {
return TCL_ERROR;
}
diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c
index 7ed751c..8ad268a 100644
--- a/generic/tclIOSock.c
+++ b/generic/tclIOSock.c
@@ -285,6 +285,34 @@ TclCreateSocketAddress(
}
/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_OpenTcpServer --
+ *
+ * Opens a TCP server socket and creates a channel around it.
+ *
+ * Results:
+ * The channel or NULL if failed. If an error occurred, an error message
+ * is left in the interp's result if interp is not NULL.
+ *
+ * Side effects:
+ * Opens a server socket and creates a new channel.
+ *
+ *----------------------------------------------------------------------
+ */
+Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port,
+ const char *host, Tcl_TcpAcceptProc *acceptProc,
+ ClientData callbackData)
+{
+ char portbuf[TCL_INTEGER_SPACE];
+
+ TclFormatInt(portbuf, port);
+
+ return Tcl_OpenTcpServerEx(interp, portbuf, host, TCL_TCPSERVER_REUSEADDR,
+ acceptProc, callbackData);
+}
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 2f1bb8b..23da6dc 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -1416,6 +1416,7 @@ const TclStubs tclStubs = {
Tcl_FindSymbol, /* 628 */
Tcl_FSUnloadFile, /* 629 */
Tcl_ZlibStreamSetCompressionDictionary, /* 630 */
+ Tcl_OpenTcpServerEx, /* 631 */
};
/* !END!: Do not edit above this line. */
diff --git a/tests/socket.test b/tests/socket.test
index d43c41c..80b0251 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -265,13 +265,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 ?-myaddr addr? port"}
+} -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"}
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 ?-myaddr addr? port"}
+} -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"}
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}
@@ -280,19 +280,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 ?-myaddr addr? port"}
+} -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"}
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, or -server}
+} -returnCodes error -result {bad option "-froboz": must be -async, -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 ?-myaddr addr? port"}
+} -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"}
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 ?-myaddr addr? port"}
+} -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"}
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"}
@@ -302,6 +302,24 @@ test socket_$af-1.13 {arg parsing for socket command} -constraints [list socket
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}
+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}
+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}
+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}
+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]
@@ -2360,6 +2378,19 @@ test socket-14.18 {bug c6ed4acfd8: running async socket connect made other conne
catch {close $csock2}
} -result {}
+test socket-14.19 {tip 456 -- introduce the -reuseport option} \
+ -constraints {socket} \
+ -body {
+ proc accept {channel address port} {}
+ set port [randport]
+ set ssock1 [socket -server accept -reuseport yes $port]
+ set ssock2 [socket -server accept -reuseport yes $port]
+ return ok
+} -cleanup {
+ catch {close $ssock1}
+ catch {close $ssock2}
+ } -result ok
+
set num 0
set x {localhost {socket} 127.0.0.1 {supported_inet} ::1 {supported_inet6}}
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index 170aea9..8e97543 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -1405,7 +1405,7 @@ TclpMakeTcpClientChannelMode(
/*
*----------------------------------------------------------------------
*
- * Tcl_OpenTcpServer --
+ * Tcl_OpenTcpServerEx --
*
* Opens a TCP server socket and creates a channel around it.
*
@@ -1420,16 +1420,17 @@ TclpMakeTcpClientChannelMode(
*/
Tcl_Channel
-Tcl_OpenTcpServer(
+Tcl_OpenTcpServerEx(
Tcl_Interp *interp, /* For error reporting - may be NULL. */
- int port, /* Port number to open. */
+ const char *service, /* Port number to open. */
const char *myHost, /* Name of local host. */
+ unsigned int flags, /* Flags. */
Tcl_TcpAcceptProc *acceptProc,
/* Callback for accepting connections from new
* clients. */
ClientData acceptProcData) /* Data for the callback. */
{
- int status = 0, sock = -1, reuseaddr = 1, chosenport;
+ int status = 0, sock = -1, optvalue, port, chosenport;
struct addrinfo *addrlist = NULL, *addrPtr; /* socket address */
TcpState *statePtr = NULL;
char channelName[SOCK_CHAN_LENGTH];
@@ -1475,6 +1476,11 @@ Tcl_OpenTcpServer(
retry++;
chosenport = 0;
+ if (TclSockGetPort(interp, service, "tcp", &port) != TCL_OK) {
+ errorMsg = "invalid port number";
+ goto error;
+ }
+
if (!TclCreateSocketAddress(interp, &addrlist, myHost, port, 1, &errorMsg)) {
my_errno = errno;
goto error;
@@ -1505,12 +1511,29 @@ Tcl_OpenTcpServer(
TclSockMinimumBuffers(INT2PTR(sock), SOCKET_BUFSIZE);
/*
- * Set up to reuse server addresses automatically and bind to the
- * specified port.
+ * Set up to reuse server addresses and/or ports if requested.
*/
- (void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR,
- (char *) &reuseaddr, sizeof(reuseaddr));
+ if (flags & TCL_TCPSERVER_REUSEADDR) {
+ optvalue = 1;
+ (void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR,
+ (char *) &optvalue, sizeof(optvalue));
+ }
+
+ if (flags & TCL_TCPSERVER_REUSEPORT) {
+#ifndef SO_REUSEPORT
+ /*
+ * If the platform doesn't support the SO_REUSEPORT flag we can't do
+ * much beside erroring out.
+ */
+ errorMsg = "SO_REUSEPORT isn't supported by this platform";
+ goto error;
+#else
+ optvalue = 1;
+ (void) setsockopt(sock, SOL_SOCKET, SO_REUSEPORT,
+ (char *) &optvalue, sizeof(optvalue));
+#endif
+ }
/*
* Make sure we use the same port number when opening two server
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index ec881d2..5e0d7c8 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -2020,7 +2020,7 @@ Tcl_MakeTcpClientChannel(
/*
*----------------------------------------------------------------------
*
- * Tcl_OpenTcpServer --
+ * Tcl_OpenTcpServerEx --
*
* Opens a TCP server socket and creates a channel around it.
*
@@ -2035,10 +2035,11 @@ Tcl_MakeTcpClientChannel(
*/
Tcl_Channel
-Tcl_OpenTcpServer(
+Tcl_OpenTcpServerEx(
Tcl_Interp *interp, /* For error reporting - may be NULL. */
- int port, /* Port number to open. */
+ const char *service, /* Port number to open. */
const char *myHost, /* Name of local host. */
+ unsigned int flags, /* Flags. */
Tcl_TcpAcceptProc *acceptProc,
/* Callback for accepting connections from new
* clients. */
@@ -2052,6 +2053,7 @@ Tcl_OpenTcpServer(
char channelName[SOCK_CHAN_LENGTH];
u_long flag = 1; /* Indicates nonblocking mode. */
const char *errorMsg = NULL;
+ int optvalue, port;
if (TclpHasSockets(interp) != TCL_OK) {
return NULL;
@@ -2071,6 +2073,11 @@ Tcl_OpenTcpServer(
* Construct the addresses for each end of the socket.
*/
+ if (TclSockGetPort(interp, service, "tcp", &port) != TCL_OK) {
+ errorMsg = "invalid port number";
+ goto error;
+ }
+
if (!TclCreateSocketAddress(interp, &addrlist, myHost, port, 1, &errorMsg)) {
goto error;
}
@@ -2110,9 +2117,17 @@ Tcl_OpenTcpServer(
}
/*
- * Bind to the specified port. Note that we must not call
- * setsockopt with SO_REUSEADDR because Microsoft allows addresses
- * to be reused even if they are still in use.
+ * The SO_REUSEADDR option on Windows behaves like SO_REUSEPORT on unix
+ * systems.
+ */
+ if (flags & TCL_TCPSERVER_REUSEPORT) {
+ optvalue = 1;
+ (void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR,
+ (char *) &optvalue, sizeof(optvalue));
+ }
+
+ /*
+ * Bind to the specified port.
*
* Bind should not be affected by the socket having already been
* set into nonblocking mode. If there is trouble, this is one