*** 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