diff options
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tcl.decls | 11 | ||||
-rw-r--r-- | generic/tcl.h | 7 | ||||
-rw-r--r-- | generic/tclDecls.h | 9 | ||||
-rw-r--r-- | generic/tclIOCmd.c | 77 | ||||
-rw-r--r-- | generic/tclIOSock.c | 28 | ||||
-rw-r--r-- | generic/tclStubInit.c | 1 |
6 files changed, 119 insertions, 14 deletions
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 a8c68a6..895245e 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/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..0eb8f99 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -1485,13 +1485,16 @@ 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, boolTmp; + unsigned int flags = TCL_TCPSERVER_REUSEADDR; + const char *host, *port, *myaddr = NULL; Tcl_Obj *script = NULL; Tcl_Channel chan; @@ -1557,6 +1560,38 @@ 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], &boolTmp) != TCL_OK) { + return TCL_ERROR; + } + if (boolTmp) { + flags |= TCL_TCPSERVER_REUSEADDR; + } else { + flags &= ~TCL_TCPSERVER_REUSEADDR; + } + 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], &boolTmp) != TCL_OK) { + return TCL_ERROR; + } + if (boolTmp) { + flags |= TCL_TCPSERVER_REUSEPORT; + } else { + flags &= ~TCL_TCPSERVER_REUSEPORT; + } + break; default: Tcl_Panic("Tcl_SocketObjCmd: bad option index to SocketOptions"); } @@ -1580,19 +1615,26 @@ 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 && flags != 0) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "options -reuseaddr and -reuseport are only valid for servers", + -1)); + return TCL_ERROR; + } + + // 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 +1642,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 +1668,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. */ |