TIP [http://www.tcl.tk/cgi-bin/tct/tip/456|456] implementation: Extend the C API to Support Passing Options to TCP Server Creationtip_456

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