summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-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
7 files changed, 125 insertions, 18 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 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. */
generated by cgit v0.12 at 2024-12-04 01:11:48 (GMT)