Attachment "halfclosesock-2.patch" to
ticket [219159ffff]
added by
andreas_kupries
2008-11-28 06:47:12.
--- tcl86.orig/generic/tcl.decls 2008-11-27 14:48:17.000000000 -0800
+++ tcl86/generic/tcl.decls 2008-11-27 14:59:25.000000000 -0800
@@ -2204,6 +2204,11 @@
int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv)
}
+# TIP#332, Half Close made public
+declare 605 generic {
+ int Tcl_CloseEx(Tcl_Interp *interp, Tcl_Channel chan, int flags)
+}
+
##############################################################################
# Define the platform specific public Tcl interface. These functions are
--- tcl86.orig/generic/tclDecls.h 2008-11-27 14:48:17.000000000 -0800
+++ tcl86/generic/tclDecls.h 2008-11-27 15:27:01.000000000 -0800
@@ -3657,6 +3657,12 @@
const Tcl_ArgvInfo * argTable, int * objcPtr,
Tcl_Obj *const * objv, Tcl_Obj *** remObjv);
#endif
+#ifndef Tcl_CloseEx_TCL_DECLARED
+#define Tcl_CloseEx_TCL_DECLARED
+/* 605 */
+EXTERN int Tcl_CloseEx (Tcl_Interp * interp, Tcl_Channel chan,
+ int flags);
+#endif
typedef struct TclStubHooks {
const struct TclPlatStubs *tclPlatStubs;
@@ -4321,6 +4327,7 @@
int (*tcl_SetEnsembleParameterList) (Tcl_Interp * interp, Tcl_Command token, Tcl_Obj * paramList); /* 602 */
int (*tcl_GetEnsembleParameterList) (Tcl_Interp * interp, Tcl_Command token, Tcl_Obj ** paramListPtr); /* 603 */
int (*tcl_ParseArgsObjv) (Tcl_Interp * interp, const Tcl_ArgvInfo * argTable, int * objcPtr, Tcl_Obj *const * objv, Tcl_Obj *** remObjv); /* 604 */
+ int (*tcl_CloseEx) (Tcl_Interp * interp, Tcl_Channel chan, int flags); /* 605 */
} TclStubs;
#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
@@ -6813,6 +6820,10 @@
#define Tcl_ParseArgsObjv \
(tclStubsPtr->tcl_ParseArgsObjv) /* 604 */
#endif
+#ifndef Tcl_CloseEx
+#define Tcl_CloseEx \
+ (tclStubsPtr->tcl_CloseEx) /* 605 */
+#endif
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
--- tcl86.orig/generic/tclIO.c 2008-11-27 14:48:17.000000000 -0800
+++ tcl86/generic/tclIO.c 2008-11-27 15:42:36.000000000 -0800
@@ -3028,6 +3028,132 @@
/*
*----------------------------------------------------------------------
*
+ * Tcl_CloseEx --
+ *
+ * Half closes a channel.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Closes one direction of the channel.
+ *
+ * NOTE:
+ * Tcl_CloseEx closes the specified direction of the channel as far as
+ * the user is concerned. The channel keeps existing however. You cannot
+ * calls this function to close the last possible direction of the
+ * channel. Use Tcl_Close for that.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+Tcl_CloseEx(
+ Tcl_Interp *interp, /* Interpreter for errors. */
+ Tcl_Channel chan, /* The channel being closed. May still be used by some interpreter */
+ int flags) /* Flags telling us which side to close. */
+{
+ Channel *chanPtr; /* The real IO channel. */
+ ChannelState *statePtr; /* State of real IO channel. */
+ int result; /* Of calling FlushChannel. */
+
+ if (chan == NULL) {
+ return TCL_OK;
+ }
+
+ /* TODO: assert flags validity ? */
+
+ chanPtr = (Channel *) chan;
+ statePtr = chanPtr->state;
+
+ /*
+ * Does the channel support half-close anyway ? Error if not.
+ */
+
+ if (!chanPtr->typePtr->close2Proc) {
+ Tcl_AppendResult (interp, "Half-close of channels not supported by ",
+ chanPtr->typePtr->typeName, "s", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Is the channel unstacked ? If not we fail.
+ */
+
+ if (chanPtr != statePtr->topChanPtr) {
+ Tcl_AppendResult (interp,
+ "Half-close not applicable to stack of transformations",
+ NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Check direction against channel mode. It is an error if we try to close
+ * a direction not supported by the channel (already closed, or never
+ * opened for that direction).
+ */
+
+ if (!(statePtr->flags & (TCL_READABLE | TCL_WRITABLE) & flags)) {
+ const char *msg;
+ if (flags & TCL_CLOSE_READ) {
+ msg = "read";
+ } else {
+ msg = "write";
+ }
+ Tcl_AppendResult (interp, "Half-close of ", msg,
+ "-side not possible, not supported by channel",
+ NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * A user may try to call half-close from within a channel close
+ * handler. That won't do.
+ */
+
+ if (statePtr->flags & CHANNEL_INCLOSE) {
+ if (interp) {
+ Tcl_AppendResult(interp, "Illegal recursive call to close "
+ "through close-handler of channel", NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ /*
+ * Finally do what is asked of us.
+ */
+
+ result = chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp,
+ flags);
+
+ /*
+ * TIP #219.
+ * Capture error messages put by the driver into the bypass area and put
+ * them into the regular interpreter result.
+ *
+ * Notes: Due to the assertion of CHANNEL_CLOSED in the flags
+ * FlushChannel() has called CloseChannel() and thus freed all the channel
+ * structures. We must not try to access "chan" anymore, hence the NULL
+ * argument in the call below. The only place which may still contain a
+ * message is the interpreter itself, and "CloseChannel" made sure to lift
+ * any channel message it generated into it.
+ */
+
+ if (TclChanCaughtErrorBypass(interp, NULL)) {
+ result = EINVAL;
+ }
+
+ if (result != 0) {
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_ClearChannelHandlers --
*
* Removes all channel handlers and event scripts from the channel,
--- tcl86.orig/generic/tclIOCmd.c 2008-11-27 14:45:57.000000000 -0800
+++ tcl86/generic/tclIOCmd.c 2008-11-27 15:41:35.000000000 -0800
@@ -648,8 +648,8 @@
{
Tcl_Channel chan; /* The channel to close. */
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "channelId");
+ if ((objc != 2) && (objc != 3)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "channelId ?direction?");
return TCL_ERROR;
}
@@ -657,6 +657,48 @@
return TCL_ERROR;
}
+ if (objc == 3) {
+ int optionIndex, dir;
+ static const char *const dirOptions[] = {
+ "read", "write", NULL
+ };
+ static int dirArray[] = {TCL_CLOSE_READ, TCL_CLOSE_WRITE};
+
+ /*
+ * Get direction requested to close, and check syntax.
+ */
+
+ if (Tcl_GetIndexFromObj(interp, objv[3], dirOptions, "direction", 0,
+ &optionIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ dir = dirArray[optionIndex];
+
+ /*
+ * Check direction against channel mode. It is an error if we try to
+ * close a direction not supported by the channel (already closed, or
+ * never opened for that direction).
+ */
+
+ if (!(dir & Tcl_GetChannelMode (chan))) {
+ Tcl_AppendResult (interp, "Half-close of ", dirOptions[optionIndex],
+ "-side not possible, not supported by channel",
+ NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Special handling is needed if and only if the channel mode supports
+ * more than the direction to close. Because if the close the last
+ * direction suppported we can and will go through the regular
+ * process.
+ */
+
+ if ((dir & Tcl_GetChannelMode (chan)) != dir) {
+ return Tcl_CloseEx (interp, chan, dir) != TCL_OK;
+ }
+ }
+
if (Tcl_UnregisterChannel(interp, chan) != TCL_OK) {
/*
* If there is an error message and it ends with a newline, remove the
--- tcl86.orig/generic/tclStubInit.c 2008-11-27 14:45:57.000000000 -0800
+++ tcl86/generic/tclStubInit.c 2008-11-27 15:27:02.000000000 -0800
@@ -1130,6 +1130,7 @@
Tcl_SetEnsembleParameterList, /* 602 */
Tcl_GetEnsembleParameterList, /* 603 */
Tcl_ParseArgsObjv, /* 604 */
+ Tcl_CloseEx, /* 605 */
};
/* !END!: Do not edit above this line. */
--- tcl86.orig/unix/tclUnixChan.c 2008-11-27 14:45:52.000000000 -0800
+++ tcl86/unix/tclUnixChan.c 2008-11-27 15:06:07.000000000 -0800
@@ -218,6 +218,9 @@
static int TcpBlockModeProc(ClientData data, int mode);
static int TcpCloseProc(ClientData instanceData,
Tcl_Interp *interp);
+static int TcpClose2Proc(ClientData instanceData,
+ Tcl_Interp *interp,
+ int flags);
static int TcpGetHandleProc(ClientData instanceData,
int direction, ClientData *handlePtr);
static int TcpGetOptionProc(ClientData instanceData,
@@ -318,7 +321,7 @@
TcpGetOptionProc, /* Get option proc. */
TcpWatchProc, /* Initialize notifier. */
TcpGetHandleProc, /* Get OS handles out of channel. */
- NULL, /* close2proc. */
+ TcpClose2Proc, /* Close2 proc. */
TcpBlockModeProc, /* Set blocking or non-blocking mode.*/
NULL, /* flush proc. */
NULL, /* handler proc. */
@@ -2018,6 +2021,57 @@
/*
*----------------------------------------------------------------------
*
+ * TcpClose2Proc --
+ *
+ * This function is called by the generic IO level to perform the channel
+ * type specific part of a half-close: namely, a shutdown() on a socket.
+ *
+ * Results:
+ * 0 if successful, the value of errno if failed.
+ *
+ * Side effects:
+ * Shuts down one side of the socket.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TcpClose2Proc(
+ ClientData instanceData, /* The socket to close. */
+ Tcl_Interp *interp, /* For error reporting. */
+ int flags) /* Flags that indicate which side to close. */
+{
+ TcpState *statePtr = (TcpState *) instanceData;
+ int errorCode = 0;
+ int sd;
+
+ /*
+ * Shutdown the OS socket handle.
+ */
+ switch(flags)
+ {
+ case TCL_CLOSE_READ:
+ sd=SHUT_RD;
+ break;
+ case TCL_CLOSE_WRITE:
+ sd=SHUT_WR;
+ break;
+ default:
+ if (interp) {
+ Tcl_AppendResult(interp, "Socket close2proc called bidirectionally", NULL);
+ }
+ return TCL_ERROR;
+ }
+ if (shutdown(statePtr->fd,sd)<0) {
+ errorCode = errno;
+ }
+
+ return errorCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TcpGetOptionProc --
*
* Computes an option value for a TCP socket based channel, or a list of
--- tcl86.orig/win/tclWinSock.c 2008-11-27 14:45:52.000000000 -0800
+++ tcl86/win/tclWinSock.c 2008-11-27 14:49:43.000000000 -0800
@@ -168,6 +168,7 @@
static Tcl_EventSetupProc SocketSetupProc;
static Tcl_DriverBlockModeProc TcpBlockProc;
static Tcl_DriverCloseProc TcpCloseProc;
+static Tcl_DriverClose2Proc TcpClose2Proc;
static Tcl_DriverSetOptionProc TcpSetOptionProc;
static Tcl_DriverGetOptionProc TcpGetOptionProc;
static Tcl_DriverInputProc TcpInputProc;
@@ -191,7 +192,7 @@
TcpGetOptionProc, /* Get option proc. */
TcpWatchProc, /* Set up notifier to watch this channel. */
TcpGetHandleProc, /* Get an OS handle from channel. */
- NULL, /* close2proc. */
+ TcpClose2Proc, /* Close2proc. */
TcpBlockProc, /* Set socket into (non-)blocking mode. */
NULL, /* flush proc. */
NULL, /* handler proc. */
@@ -818,6 +819,58 @@
/*
*----------------------------------------------------------------------
*
+ * TcpClose2Proc --
+ *
+ * This function is called by the generic IO level to perform the channel
+ * type specific part of a half-close: namely, a shutdown() on a socket.
+ *
+ * Results:
+ * 0 if successful, the value of errno if failed.
+ *
+ * Side effects:
+ * Shuts down one side of the socket.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TcpClose2Proc(
+ ClientData instanceData, /* The socket to close. */
+ Tcl_Interp *interp, /* For error reporting. */
+ int flags) /* Flags that indicate which side to close. */
+{
+ SocketInfo *infoPtr = (SocketInfo *) instanceData;
+ int errorCode = 0;
+ int sd;
+
+ /*
+ * Shutdown the OS socket handle.
+ */
+ switch(flags)
+ {
+ case TCL_CLOSE_READ:
+ sd=SD_RECEIVE;
+ break;
+ case TCL_CLOSE_WRITE:
+ sd=SD_SEND;
+ break;
+ default:
+ if (interp) {
+ Tcl_AppendResult(interp, "Socket close2proc called bidirectionally", NULL);
+ }
+ return TCL_ERROR;
+ }
+ if (shutdown(infoPtr->socket,sd) == SOCKET_ERROR) {
+ TclWinConvertWSAError((DWORD) WSAGetLastError());
+ errorCode = Tcl_GetErrno();
+ }
+
+ return errorCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* NewSocketInfo --
*
* This function allocates and initializes a new SocketInfo structure.
