Implement the whole TIP 456 specification.

Also introduces the `-reuseaddr' and `-reuseport' options for the `socket'
command.

5 files changed, 31 insertions, 11 deletions

diff --git a/generic/tcl.decls b/generic/tcl.decls
index 20c3f3e..af496b3 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -2329,7 +2329,7 @@ declare 630 {
 # TIP #456
 declare 631 {
     Tcl_Channel Tcl_OpenTcpServerEx(Tcl_Interp *interp, int port,
-	    const char *host, int flags, Tcl_TcpAcceptProc *acceptProc,
+	    const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc,
 	    ClientData callbackData)
 }
 
diff --git a/generic/tcl.h b/generic/tcl.h
index eb53c70..75a947a 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2371,6 +2371,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/tclDecls.h b/generic/tclDecls.h
index d1c1170..4810c51 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -1818,7 +1818,7 @@ EXTERN void		Tcl_ZlibStreamSetCompressionDictionary(
 				Tcl_Obj *compressionDictionaryObj);
 /* 631 */
 EXTERN Tcl_Channel	Tcl_OpenTcpServerEx(Tcl_Interp *interp, int port,
-				const char *host, int flags,
+				const char *host, unsigned int flags,
 				Tcl_TcpAcceptProc *acceptProc,
 				ClientData callbackData);
 
@@ -2487,7 +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 */
+    Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, int port, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 631 */
 } TclStubs;
 
 extern const TclStubs *tclStubsPtr;
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 883c6b7..b4696fd 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -1485,12 +1485,15 @@ Tcl_SocketObjCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     static const char *const socketOptions[] = {
-	"-async", "-myaddr", "-myport", "-server", "-reuseport", NULL
+	"-async", "-myaddr", "-myport", "-server", "-reuseaddr", "-reuseport",
+	NULL
     };
     enum socketOptions {
-	SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_SERVER, SKT_REUSEPORT
+	SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_SERVER, SKT_REUSEADDR,
+	SKT_REUSEPORT
     };
-    int optionIndex, a, server = 0, port, myport = 0, async = 0, flags = 0;
+    int optionIndex, a, server = 0, port, myport = 0, async = 0;
+    unsigned int flags = 0;
     const char *host, *myaddr = NULL;
     Tcl_Obj *script = NULL;
     Tcl_Channel chan;
@@ -1557,8 +1560,11 @@ Tcl_SocketObjCmd(
 	    }
 	    script = objv[a];
 	    break;
+	case SKT_REUSEADDR:
+	    flags |= TCL_TCPSERVER_REUSEADDR;
+	    break;
 	case SKT_REUSEPORT:
-	    flags |= 1;
+	    flags |= TCL_TCPSERVER_REUSEPORT;
 	    break;
 	default:
 	    Tcl_Panic("Tcl_SocketObjCmd: bad option index to SocketOptions");
@@ -1583,7 +1589,14 @@ 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? ?-reuseport? ?-myaddr addr? port");
+	return TCL_ERROR;
+    }
+
+    if (!server && flags != 0) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"options -reuseaddr and -reuseport are only valid for servers",
+		-1));
 	return TCL_ERROR;
     }
 
diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c
index 72a0b5a..b6e99ba 100644
--- a/generic/tclIOSock.c
+++ b/generic/tclIOSock.c
@@ -283,7 +283,7 @@ TclCreateSocketAddress(
     }
     return 1;
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
@@ -304,9 +304,9 @@ 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);
+    return Tcl_OpenTcpServerEx(interp, port, host, TCL_TCPSERVER_REUSEADDR,
+			       acceptProc, callbackData);
 }
-
 
 /*
  * Local Variables: