Attachment "halfclose-4.patch" to
ticket [219159ffff]
added by
ferrieux
2008-12-01 22:44:29.
Index: generic/tcl.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.decls,v
retrieving revision 1.154
diff -u -r1.154 tcl.decls
--- generic/tcl.decls 17 Nov 2008 22:15:34 -0000 1.154
+++ generic/tcl.decls 1 Dec 2008 15:29:59 -0000
@@ -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
Index: generic/tclDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclDecls.h,v
retrieving revision 1.156
diff -u -r1.156 tclDecls.h
--- generic/tclDecls.h 17 Nov 2008 22:15:34 -0000 1.156
+++ generic/tclDecls.h 1 Dec 2008 15:29:59 -0000
@@ -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) */
Index: generic/tclIO.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIO.c,v
retrieving revision 1.150
diff -u -r1.150 tclIO.c
--- generic/tclIO.c 25 Nov 2008 23:19:01 -0000 1.150
+++ generic/tclIO.c 1 Dec 2008 15:30:00 -0000
@@ -3028,6 +3028,137 @@
/*
*----------------------------------------------------------------------
*
+ * 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, side not opened or already closed",
+ 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.
+ *
+ *
+ * [Alex: I don't understand the comment below. The half-close preserves chanPtr ]
+ *
+ * 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;
+ }
+
+ statePtr->flags &= ~(flags & (TCL_READABLE | TCL_WRITABLE));
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_ClearChannelHandlers --
*
* Removes all channel handlers and event scripts from the channel,
Index: generic/tclIOCmd.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIOCmd.c,v
retrieving revision 1.59
diff -u -r1.59 tclIOCmd.c
--- generic/tclIOCmd.c 16 Oct 2008 22:34:19 -0000 1.59
+++ generic/tclIOCmd.c 1 Dec 2008 15:30:00 -0000
@@ -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[2], 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, side not opened or already closed",
+ 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 ((Tcl_GetChannelMode (chan) & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) != 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
Index: generic/tclStubInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclStubInit.c,v
retrieving revision 1.167
diff -u -r1.167 tclStubInit.c
--- generic/tclStubInit.c 22 Oct 2008 20:23:59 -0000 1.167
+++ generic/tclStubInit.c 1 Dec 2008 15:30:00 -0000
@@ -1130,6 +1130,7 @@
Tcl_SetEnsembleParameterList, /* 602 */
Tcl_GetEnsembleParameterList, /* 603 */
Tcl_ParseArgsObjv, /* 604 */
+ Tcl_CloseEx, /* 605 */
};
/* !END!: Do not edit above this line. */
Index: unix/tclUnixChan.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixChan.c,v
retrieving revision 1.96
diff -u -r1.96 tclUnixChan.c
--- unix/tclUnixChan.c 26 Oct 2008 12:45:04 -0000 1.96
+++ unix/tclUnixChan.c 1 Dec 2008 15:30:01 -0000
@@ -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
Index: unix/tclUnixPipe.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixPipe.c,v
retrieving revision 1.44
diff -u -r1.44 tclUnixPipe.c
--- unix/tclUnixPipe.c 21 Jul 2008 21:46:47 -0000 1.44
+++ unix/tclUnixPipe.c 1 Dec 2008 15:30:01 -0000
@@ -51,8 +51,10 @@
*/
static int PipeBlockModeProc(ClientData instanceData, int mode);
-static int PipeCloseProc(ClientData instanceData,
- Tcl_Interp *interp);
+static int PipeClose2Proc(ClientData instanceData,
+ Tcl_Interp *interp, int flags);
+/* static int PipeCloseProc(ClientData instanceData,
+ Tcl_Interp *interp); */
static int PipeGetHandleProc(ClientData instanceData,
int direction, ClientData *handlePtr);
static int PipeInputProc(ClientData instanceData, char *buf,
@@ -71,7 +73,7 @@
static Tcl_ChannelType pipeChannelType = {
"pipe", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
- PipeCloseProc, /* Close proc. */
+ TCL_CLOSE2PROC, /* Close proc. */
PipeInputProc, /* Input proc. */
PipeOutputProc, /* Output proc. */
NULL, /* Seek proc. */
@@ -79,7 +81,7 @@
NULL, /* Get option proc. */
PipeWatchProc, /* Initialize notifier. */
PipeGetHandleProc, /* Get OS handles out of channel. */
- NULL, /* close2proc. */
+ PipeClose2Proc, /* close2proc. */
PipeBlockModeProc, /* Set blocking or non-blocking mode.*/
NULL, /* flush proc. */
NULL, /* handler proc. */
@@ -905,7 +907,96 @@
/*
*----------------------------------------------------------------------
*
- * PipeCloseProc --
+ * PipeClose2Proc
+ *
+ * This function is invoked by the generic IO level to perform
+ * pipeline-type-specific half or full-close.
+ *
+ * Results:
+ * 0 on success, errno otherwise.
+ *
+ * Side effects:
+ * Closes the command pipeline channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+PipeClose2Proc(
+ ClientData instanceData, /* The pipe to close. */
+ Tcl_Interp *interp, /* For error reporting. */
+ int flags) /* Flags that indicate which side to close. */
+{
+ PipeState *pipePtr= (PipeState *) instanceData;
+ Tcl_Channel errChan;
+ int errorCode, result;
+
+ errorCode = 0;
+ result = 0;
+
+ if (((!flags)||(flags & TCL_CLOSE_READ)) && (pipePtr->inFile != NULL)) {
+ if (TclpCloseFile(pipePtr->inFile) < 0) {
+ errorCode = errno;
+ } else {
+ pipePtr->inFile=NULL;
+ }
+ }
+ if (((!flags)||(flags & TCL_CLOSE_WRITE)) && (pipePtr->outFile != NULL) && (errorCode == 0)) {
+ if (TclpCloseFile(pipePtr->outFile) < 0) {
+ errorCode = errno;
+ } else {
+ pipePtr->outFile=NULL;
+ }
+ }
+
+ /* if half-closing, stop here. */
+ if (flags) {
+ return errorCode;
+ }
+
+ if (pipePtr->isNonBlocking || TclInExit()) {
+ /*
+ * If the channel is non-blocking or Tcl is being cleaned up, just
+ * detach the children PIDs, reap them (important if we are in a
+ * dynamic load module), and discard the errorFile.
+ */
+
+ Tcl_DetachPids(pipePtr->numPids, pipePtr->pidPtr);
+ Tcl_ReapDetachedProcs();
+
+ if (pipePtr->errorFile) {
+ TclpCloseFile(pipePtr->errorFile);
+ }
+ } else {
+ /*
+ * Wrap the error file into a channel and give it to the cleanup
+ * routine.
+ */
+
+ if (pipePtr->errorFile) {
+ errChan = Tcl_MakeFileChannel(
+ (ClientData) INT2PTR(GetFd(pipePtr->errorFile)), TCL_READABLE);
+ } else {
+ errChan = NULL;
+ }
+ result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr,
+ errChan);
+ }
+
+ if (pipePtr->numPids != 0) {
+ ckfree((char *) pipePtr->pidPtr);
+ }
+ ckfree((char *) pipePtr);
+ if (errorCode == 0) {
+ return result;
+ }
+ return errorCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PipeCloseProc -- OBSOLETE
*
* This function is invoked by the generic IO level to perform
* channel-type-specific cleanup when a command pipeline channel is
@@ -933,6 +1024,7 @@
errorCode = 0;
result = 0;
pipePtr = (PipeState *) instanceData;
+
if (pipePtr->inFile) {
if (TclpCloseFile(pipePtr->inFile) < 0) {
errorCode = errno;
Index: win/tclWinSock.c
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinSock.c,v
retrieving revision 1.63
diff -u -r1.63 tclWinSock.c
--- win/tclWinSock.c 26 Oct 2008 18:43:27 -0000 1.63
+++ win/tclWinSock.c 1 Dec 2008 15:30:01 -0000
@@ -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.