summaryrefslogtreecommitdiffstats
path: root/generic/tclIOCmd.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclIOCmd.c')
-rw-r--r--generic/tclIOCmd.c145
1 files changed, 38 insertions, 107 deletions
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 6e8bd09..834f225 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -16,7 +16,7 @@
*/
typedef struct AcceptCallback {
- Tcl_Obj *script; /* Script to invoke. */
+ char *script; /* Script to invoke. */
Tcl_Interp *interp; /* Interpreter in which to run it. */
} AcceptCallback;
@@ -25,7 +25,7 @@ typedef struct AcceptCallback {
* It must be per-thread because of std channel limitations.
*/
-typedef struct {
+typedef struct ThreadSpecificData {
int initialized; /* Set to 1 when the module is initialized. */
Tcl_Obj *stdoutObjPtr; /* Cached stdout channel Tcl_Obj */
} ThreadSpecificData;
@@ -37,7 +37,8 @@ static Tcl_ThreadDataKey dataKey;
*/
static void FinalizeIOCmdTSD(ClientData clientData);
-static Tcl_TcpAcceptProc AcceptCallbackProc;
+static void AcceptCallbackProc(ClientData callbackData,
+ Tcl_Channel chan, char *address, int port);
static int ChanPendingObjCmd(ClientData unused,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -113,6 +114,7 @@ Tcl_PutsObjCmd(
int newline; /* Add a newline at end? */
int result; /* Result of puts operation. */
int mode; /* Mode in which channel is opened. */
+ ThreadSpecificData *tsdPtr;
switch (objc) {
case 2: /* [puts $x] */
@@ -159,7 +161,7 @@ Tcl_PutsObjCmd(
}
if (chanObjPtr == NULL) {
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ tsdPtr = TCL_TSD_INIT(&dataKey);
if (!tsdPtr->initialized) {
tsdPtr->initialized = 1;
@@ -1371,22 +1373,15 @@ AcceptCallbackProc(
*/
if (acceptCallbackPtr->interp != NULL) {
+ char portBuf[TCL_INTEGER_SPACE];
+ char *script = acceptCallbackPtr->script;
Tcl_Interp *interp = acceptCallbackPtr->interp;
- Tcl_Obj *script, *objv[2];
- int result = TCL_OK;
-
- objv[0] = acceptCallbackPtr->script;
- objv[1] = Tcl_NewListObj(3, NULL);
- Tcl_ListObjAppendElement(NULL, objv[1], Tcl_NewStringObj(
- Tcl_GetChannelName(chan), -1));
- Tcl_ListObjAppendElement(NULL, objv[1], Tcl_NewStringObj(address, -1));
- Tcl_ListObjAppendElement(NULL, objv[1], Tcl_NewIntObj(port));
-
- script = Tcl_ConcatObj(2, objv);
- Tcl_IncrRefCount(script);
- Tcl_DecrRefCount(objv[1]);
+ int result;
+ Tcl_Preserve(script);
Tcl_Preserve(interp);
+
+ TclFormatInt(portBuf, port);
Tcl_RegisterChannel(interp, chan);
/*
@@ -1396,9 +1391,8 @@ AcceptCallbackProc(
Tcl_RegisterChannel(NULL, chan);
- result = Tcl_EvalObjEx(interp, script, TCL_EVAL_DIRECT|TCL_EVAL_GLOBAL);
- Tcl_DecrRefCount(script);
-
+ result = Tcl_VarEval(interp, script, " ", Tcl_GetChannelName(chan),
+ " ", address, " ", portBuf, NULL);
if (result != TCL_OK) {
Tcl_BackgroundException(interp, result);
Tcl_UnregisterChannel(interp, chan);
@@ -1412,6 +1406,7 @@ AcceptCallbackProc(
Tcl_UnregisterChannel(NULL, chan);
Tcl_Release(interp);
+ Tcl_Release(script);
} else {
/*
* The interpreter has been deleted, so there is no useful way to use
@@ -1455,7 +1450,7 @@ TcpServerCloseProc(
UnregisterTcpServerInterpCleanupProc(acceptCallbackPtr->interp,
acceptCallbackPtr);
}
- Tcl_DecrRefCount(acceptCallbackPtr->script);
+ Tcl_EventuallyFree(acceptCallbackPtr->script, TCL_DYNAMIC);
ckfree(acceptCallbackPtr);
}
@@ -1484,18 +1479,13 @@ Tcl_SocketObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
static const char *const socketOptions[] = {
- "-async", "-myaddr", "-myport", "-reuseaddr", "-reuseport", "-server",
- NULL
+ "-async", "-myaddr", "-myport", "-server", NULL
};
enum socketOptions {
- SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_REUSEADDR, SKT_REUSEPORT,
- SKT_SERVER
+ SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_SERVER
};
- 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;
+ int optionIndex, a, server = 0, port, myport = 0, async = 0;
+ const char *host, *script = NULL, *myaddr = NULL;
Tcl_Channel chan;
if (TclpHasSockets(interp) != TCL_OK) {
@@ -1558,29 +1548,7 @@ Tcl_SocketObjCmd(
"no argument given for -server option", -1));
return TCL_ERROR;
}
- 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;
- }
+ script = TclGetString(objv[a]);
break;
default:
Tcl_Panic("Tcl_SocketObjCmd: bad option index to SocketOptions");
@@ -1605,63 +1573,32 @@ Tcl_SocketObjCmd(
"?-myaddr addr? ?-myport myport? ?-async? host port");
iPtr->flags |= INTERP_ALTERNATE_WRONG_ARGS;
Tcl_WrongNumArgs(interp, 1, objv,
- "-server command ?-reuseaddr boolean? ?-reuseport boolean? "
- "?-myaddr addr? port");
- return TCL_ERROR;
- }
-
- if (!server && (reusea != -1 || reusep != -1)) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "options -reuseaddr and -reuseport are only valid for servers",
- -1));
+ "-server command ?-myaddr addr? port");
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) {
+ if (a == objc-1) {
+ if (TclSockGetPort(interp, TclGetString(objv[a]), "tcp",
+ &port) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
goto wrongNumArgs;
}
- port = TclGetString(objv[a]);
-
if (server) {
- AcceptCallback *acceptCallbackPtr = ckalloc(sizeof(AcceptCallback));
+ AcceptCallback *acceptCallbackPtr =
+ ckalloc(sizeof(AcceptCallback));
+ unsigned len = strlen(script) + 1;
+ char *copyScript = ckalloc(len);
- Tcl_IncrRefCount(script);
- acceptCallbackPtr->script = script;
+ memcpy(copyScript, script, len);
+ acceptCallbackPtr->script = copyScript;
acceptCallbackPtr->interp = interp;
-
- chan = Tcl_OpenTcpServerEx(interp, port, host, flags,
- AcceptCallbackProc, acceptCallbackPtr);
+ chan = Tcl_OpenTcpServer(interp, port, host, AcceptCallbackProc,
+ acceptCallbackPtr);
if (chan == NULL) {
- Tcl_DecrRefCount(script);
+ ckfree(copyScript);
ckfree(acceptCallbackPtr);
return TCL_ERROR;
}
@@ -1683,13 +1620,7 @@ Tcl_SocketObjCmd(
Tcl_CreateCloseHandler(chan, TcpServerCloseProc, acceptCallbackPtr);
} else {
- int portNum;
-
- if (TclSockGetPort(interp, port, "tcp", &portNum) != TCL_OK) {
- return TCL_ERROR;
- }
-
- chan = Tcl_OpenTcpClient(interp, portNum, host, myaddr, myport, async);
+ chan = Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async);
if (chan == NULL) {
return TCL_ERROR;
}
generated by cgit v0.12 at 2024-08-21 00:05:34 (GMT)