Attachment "patch.txt" to
ticket [1096957fff]
added by
yahalom
2005-01-06 16:20:21.
Also attachment "patch.txt" to
ticket [947693ffff]
added by
davygrvy
2004-06-06 09:04:22.
*** generic/tclBasic.c 30 May 2004 12:18:25 -0000 1.104
--- generic/tclBasic.c 6 Jun 2004 01:59:27 -0000
***************
*** 201,206 ****
--- 201,208 ----
(CompileProc *) NULL, 1},
{"glob", (Tcl_CmdProc *) NULL, Tcl_GlobObjCmd,
(CompileProc *) NULL, 0},
+ {"kill", (Tcl_CmdProc *) NULL, Tcl_KillObjCmd,
+ (CompileProc *) NULL, 0},
{"open", (Tcl_CmdProc *) NULL, Tcl_OpenObjCmd,
(CompileProc *) NULL, 0},
{"pid", (Tcl_CmdProc *) NULL, Tcl_PidObjCmd,
*** generic/tclInt.h 30 May 2004 12:18:25 -0000 1.162
--- generic/tclInt.h 6 Jun 2004 01:59:33 -0000
***************
*** 2001,2006 ****
--- 2001,2008 ----
Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_JoinObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+ EXTERN int Tcl_KillObjCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_LappendObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_LassignObjCmd _ANSI_ARGS_((ClientData clientData,
*** unix/tclUnixPipe.c 6 Apr 2004 22:25:57 -0000 1.24
--- unix/tclUnixPipe.c 6 Jun 2004 01:59:38 -0000
***************
*** 1246,1248 ****
--- 1246,1302 ----
}
return TCL_OK;
}
+
+ /*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_KillObjCmd --
+ *
+ * Kill a process given a pipe channel.
+ *
+ * Results:
+ * nothing or an error message.
+ *
+ * Side effects:
+ * None known.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ int
+ Tcl_KillObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST *objv) /* Argument strings. */
+ {
+ Tcl_Channel chan;
+ PipeInfo *pipePtr;
+ int result;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "channelId");
+ return TCL_ERROR;
+ }
+ chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL);
+ if (chan == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("no such channel.", -1));
+ return TCL_ERROR;
+ }
+ if (Tcl_GetChannelType(chan) != &pipeChannelType) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("not a pipe channel.", -1));
+ return TCL_ERROR;
+ }
+ pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);
+
+ /* Terminate the root process. */
+ result = kill(pipePtr->pidPtr[0], SIGKILL);
+
+ if (result == -1) {
+ Tcl_AppendResult(interp, "couldn't kill process: ",
+ Tcl_PosixError(interp), NULL);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+ }
*** win/tclWinPipe.c 30 May 2004 21:57:09 -0000 1.48
--- win/tclWinPipe.c 6 Jun 2004 01:59:49 -0000
***************
*** 1884,1889 ****
--- 1884,1891 ----
DWORD exitCode;
errorCode = 0;
+ result = 0;
+
if ((!flags || (flags == TCL_CLOSE_READ))
&& (pipePtr->readFile != NULL)) {
/*
***************
*** 2044,2067 ****
}
}
! /*
! * Wrap the error file into a channel and give it to the cleanup
! * routine.
! */
! if (pipePtr->errorFile) {
! WinFile *filePtr;
! filePtr = (WinFile*)pipePtr->errorFile;
! errChan = Tcl_MakeFileChannel((ClientData) filePtr->handle,
! TCL_READABLE);
! ckfree((char *) filePtr);
! } else {
! errChan = NULL;
! }
! result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr,
! errChan);
if (pipePtr->numPids > 0) {
ckfree((char *) pipePtr->pidPtr);
--- 2046,2084 ----
}
}
! if ((pipePtr->flags & PIPE_ASYNC) || 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) {
! WinFile *filePtr;
! filePtr = (WinFile*)pipePtr->errorFile;
! errChan = Tcl_MakeFileChannel((ClientData) filePtr->handle,
! TCL_READABLE);
! ckfree((char *) filePtr);
! } else {
! errChan = NULL;
! }
! result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr,
! errChan);
! }
if (pipePtr->numPids > 0) {
ckfree((char *) pipePtr->pidPtr);
***************
*** 2728,2733 ****
--- 2745,2806 ----
/*
*----------------------------------------------------------------------
*
+ * Tcl_KillObjCmd --
+ *
+ * Kill a process given a pipe channel.
+ *
+ * Results:
+ * nothing or an error message.
+ *
+ * Side effects:
+ * Does not close the handle to the process. This is done by
+ * either TclReapDetachedProcs or Tcl_WaitPid when the pipe
+ * channel is eventually closed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ int
+ Tcl_KillObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST *objv) /* Argument strings. */
+ {
+ Tcl_Channel chan;
+ PipeInfo *pipePtr;
+ BOOL ok;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "channelId");
+ return TCL_ERROR;
+ }
+ chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL);
+ if (chan == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("no such channel.", -1));
+ return TCL_ERROR;
+ }
+ if (Tcl_GetChannelType(chan) != &pipeChannelType) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("not a pipe channel.", -1));
+ return TCL_ERROR;
+ }
+ pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);
+
+ /* Terminate the root process with an exitcode of 7. */
+ ok = TerminateProcess(pipePtr->pidPtr[0], 7);
+
+ if (!ok) {
+ TclWinConvertError(GetLastError());
+ Tcl_AppendResult(interp, "couldn't kill process: ",
+ Tcl_PosixError(interp), NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+ }
+
+ /*
+ *----------------------------------------------------------------------
+ *
* WaitForRead --
*
* Wait until some data is available, the pipe is at
