Added stub entry for tip #456. Documentation and tests still missing. Doesn't conform to TIP yet.

7 files changed, 58 insertions, 20 deletions

diff --git a/generic/tcl.decls b/generic/tcl.decls
index 574b49b..20c3f3e 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, int port,
+	    const char *host, 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/tclDecls.h b/generic/tclDecls.h
index b022d3c..d1c1170 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -1816,6 +1816,11 @@ 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, int port,
+				const char *host, int flags,
+				Tcl_TcpAcceptProc *acceptProc,
+				ClientData callbackData);
 
 typedef struct {
     const struct TclPlatStubs *tclPlatStubs;
@@ -2482,6 +2487,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, int port, const char *host, int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 631 */
 } TclStubs;
 
 extern const TclStubs *tclStubsPtr;
@@ -3774,6 +3780,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 9dc8f07..883c6b7 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -1490,7 +1490,7 @@ Tcl_SocketObjCmd(
     enum socketOptions {
 	SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_SERVER, SKT_REUSEPORT
     };
-    int optionIndex, a, server = 0, port, myport = 0, async = 0, reuseport = 0;
+    int optionIndex, a, server = 0, port, myport = 0, async = 0, flags = 0;
     const char *host, *myaddr = NULL;
     Tcl_Obj *script = NULL;
     Tcl_Channel chan;
@@ -1557,9 +1557,9 @@ Tcl_SocketObjCmd(
 	    }
 	    script = objv[a];
 	    break;
-    case SKT_REUSEPORT:
-        reuseport = 1;
-        break;
+	case SKT_REUSEPORT:
+	    flags |= 1;
+	    break;
 	default:
 	    Tcl_Panic("Tcl_SocketObjCmd: bad option index to SocketOptions");
 	}
@@ -1604,12 +1604,7 @@ Tcl_SocketObjCmd(
 	acceptCallbackPtr->script = script;
 	acceptCallbackPtr->interp = interp;
 
-    /* Hint for Tcl_OpenTcpServer to set socket option REUSEPORT */
-    if(reuseport) {
-        port |= (1 << 16);
-    }
-
-	chan = Tcl_OpenTcpServer(interp, port, host, AcceptCallbackProc,
+	chan = Tcl_OpenTcpServerEx(interp, port, host, flags, AcceptCallbackProc,
 		acceptCallbackPtr);
 	if (chan == NULL) {
 	    Tcl_DecrRefCount(script);
diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c
index 7ed751c..72a0b5a 100644
--- a/generic/tclIOSock.c
+++ b/generic/tclIOSock.c
@@ -283,6 +283,30 @@ TclCreateSocketAddress(
     }
     return 1;
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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)
+{
+    return Tcl_OpenTcpServerEx(interp, port, host, 0, acceptProc, callbackData);
+}
+
 
 /*
  * Local Variables:
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/unix/tclUnixSock.c b/unix/tclUnixSock.c
index d8a33f9..6286b2f 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -115,7 +115,7 @@ struct TcpState {
 
 #ifdef SO_REUSEPORT
 /* Bitmask to check if the setting of SO_REUSEPORT was requested by the caller. */
-#define USE_SOCK_REUSEPORT (1 << 16)
+#define USE_SOCK_REUSEPORT 1
 #endif
 
 /*
@@ -1410,7 +1410,7 @@ TclpMakeTcpClientChannelMode(
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_OpenTcpServer --
+ * Tcl_OpenTcpServerEx --
  *
  *	Opens a TCP server socket and creates a channel around it.
  *
@@ -1425,10 +1425,11 @@ TclpMakeTcpClientChannelMode(
  */
 
 Tcl_Channel
-Tcl_OpenTcpServer(
+Tcl_OpenTcpServerEx(
     Tcl_Interp *interp,		/* For error reporting - may be NULL. */
     int port,			/* Port number to open. */
     const char *myHost,		/* Name of local host. */
+    int flags,			/* Flags. */
     Tcl_TcpAcceptProc *acceptProc,
 				/* Callback for accepting connections from new
 				 * clients. */
@@ -1440,10 +1441,6 @@ Tcl_OpenTcpServer(
     char channelName[SOCK_CHAN_LENGTH];
     const char *errorMsg = NULL;
     TcpFdList *fds = NULL, *newfds;
-#ifdef SO_REUSEPORT
-    int reuseport = port & USE_SOCK_REUSEPORT;
-    CLEAR_BITS(port, USE_SOCK_REUSEPORT);
-#endif
 
     /*
      * Try to record and return the most meaningful error message, i.e. the
@@ -1526,7 +1523,8 @@ Tcl_OpenTcpServer(
      * Set up to allows multiple sockets on the same host to bind to the same port.
      * The flag can be switched on by setting the lowest bit above the valid maximum port (0xffff).
      */
-    if(reuseport) {
+    if (flags & USE_SOCK_REUSEPORT) {
+	int reuseport = 1;
         (void) setsockopt(sock, SOL_SOCKET, SO_REUSEPORT,
             (char *) &reuseport, sizeof(reuseport));
     }
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index af8dda1..a389d45 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 *myHost,		/* Name of local host. */
+    int flags,			/* Flags (not used) */
     Tcl_TcpAcceptProc *acceptProc,
 				/* Callback for accepting connections from new
 				 * clients. */