/* * tclPipe.c -- * * This file contains the generic portion of the command channel * driver as well as various utility routines used in managing * subprocesses. * * Copyright (c) 1997 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclPipe.c,v 1.7.2.3 2005/10/05 22:09:11 andreas_kupries Exp $ */ #include "tclInt.h" #include "tclPort.h" /* * A linked list of the following structures is used to keep track * of child processes that have been detached but haven't exited * yet, so we can make sure that they're properly "reaped" (officially * waited for) and don't lie around as zombies cluttering the * system. */ typedef struct Detached { Tcl_Pid pid; /* Id of process that's been detached * but isn't known to have exited. */ struct Detached *nextPtr; /* Next in list of all detached * processes. */ } Detached; static Detached *detList = NULL; /* List of all detached proceses. */ TCL_DECLARE_MUTEX(pipeMutex) /* Guard access to detList. */ /* * Declarations for local procedures defined in this file: */ static TclFile FileForRedirect _ANSI_ARGS_((Tcl_Interp *interp, CONST char *spec, int atOk, CONST char *arg, CONST char *nextArg, int flags, int *skipPtr, int *closePtr, int *releasePtr)); /* *---------------------------------------------------------------------- * * FileForRedirect -- * * This procedure does much of the work of parsing redirection * operators. It handles "@" if specified and allowed, and a file * name, and opens the file if necessary. * * Results: * The return value is the descriptor number for the file. If an * error occurs then NULL is returned and an error message is left * in the interp's result. Several arguments are side-effected; see * the argument list below for details. * * Side effects: * None. * *---------------------------------------------------------------------- */ static TclFile FileForRedirect(interp, spec, atOK, arg, nextArg, flags, skipPtr, closePtr, releasePtr) Tcl_Interp *interp; /* Intepreter to use for error reporting. */ CONST char *spec; /* Points to character just after * redirection character. */ int atOK; /* Non-zero means that '@' notation can be * used to specify a channel, zero means that * it isn't. */ CONST char *arg; /* Pointer to entire argument containing * spec: used for error reporting. */ CONST char *nextArg; /* Next argument in argc/argv array, if needed * for file name or channel name. May be * NULL. */ int flags; /* Flags to use for opening file or to * specify mode for channel. */ int *skipPtr; /* Filled with 1 if redirection target was * in spec, 2 if it was in nextArg. */ int *closePtr; /* Filled with one if the caller should * close the file when done with it, zero * otherwise. */ int *releasePtr; { int writing = (flags & O_WRONLY); Tcl_Channel chan; TclFile file; *skipPtr = 1; if ((atOK != 0) && (*spec == '@')) { spec++; if (*spec == '\0') { spec = nextArg; if (spec == NULL) { goto badLastArg; } *skipPtr = 2; } chan = Tcl_GetChannel(interp, spec, NULL); if (chan == (Tcl_Channel) NULL) { return NULL; } file = TclpMakeFile(chan, writing ? TCL_WRITABLE : TCL_READABLE); if (file == NULL) { Tcl_AppendResult(interp, "channel \"", Tcl_GetChannelName(chan), "\" wasn't opened for ", ((writing) ? "writing" : "reading"), (char *) NULL); return NULL; } *releasePtr = 1; if (writing) { /* * Be sure to flush output to the file, so that anything * written by the child appears after stuff we've already * written. */ Tcl_Flush(chan); } } else { CONST char *name; Tcl_DString nameString; if (*spec == '\0') { spec = nextArg; if (spec == NULL) { goto badLastArg; } *skipPtr = 2; } name = Tcl_TranslateFileName(interp, spec, &nameString); if (name != NULL) { file = TclpOpenFile(name, flags); } else { file = NULL; } Tcl_DStringFree(&nameString); if (file == NULL) { Tcl_AppendResult(interp, "couldn't ", ((writing) ? "write" : "read"), " file \"", spec, "\": ", Tcl_PosixError(interp), (char *) NULL); return NULL; } *closePtr = 1; } return file; badLastArg: Tcl_AppendResult(interp, "can't specify \"", arg, "\" as last word in command", (char *) NULL); return NULL; } /* *---------------------------------------------------------------------- * * Tcl_DetachPids -- * * This procedure is called to indicate that one or more child * processes have been placed in background and will never be * waited for; they should eventually be reaped by * Tcl_ReapDetachedProcs. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void Tcl_DetachPids(numPids, pidPtr) int numPids; /* Number of pids to detach: gives size * of array pointed to by pidPtr. */ Tcl_Pid *pidPtr; /* Array of pids to detach. */ { register Detached *detPtr; int i; Tcl_MutexLock(&pipeMutex); for (i = 0; i < numPids; i++) { detPtr = (Detached *) ckalloc(sizeof(Detached)); detPtr->pid = pidPtr[i]; detPtr->nextPtr = detList; detList = detPtr; } Tcl_MutexUnlock(&pipeMutex); } /* *---------------------------------------------------------------------- * * Tcl_ReapDetachedProcs -- * * This procedure checks to see if any detached processes have * exited and, if so, it "reaps" them by officially waiting on * them. It should be called "occasionally" to make sure that * all detached processes are eventually reaped. * * Results: * None. * * Side effects: * Processes are waited on, so that they can be reaped by the * system. * *---------------------------------------------------------------------- */ void Tcl_ReapDetachedProcs() { register Detached *detPtr; Detached *nextPtr, *prevPtr; int status; Tcl_Pid pid; Tcl_MutexLock(&pipeMutex); for (detPtr = detList, prevPtr = NULL; detPtr != NULL; ) { pid = Tcl_WaitPid(detPtr->pid, &status, WNOHANG); if ((pid == 0) || ((pid == (Tcl_Pid) -1) && (errno != ECHILD))) { prevPtr = detPtr; detPtr = detPtr->nextPtr; continue; } nextPtr = detPtr->nextPtr; if (prevPtr == NULL) { detList = detPtr->nextPtr; } else { prevPtr->nextPtr = detPtr->nextPtr; } ckfree((char *) detPtr); detPtr = nextPtr; } Tcl_MutexUnlock(&pipeMutex); } /* *---------------------------------------------------------------------- * * TclCleanupChildren -- * * This is a utility procedure used to wait for child processes * to exit, record information about abnormal exits, and then * collect any stderr output generated by them. * * Results: * The return value is a standard Tcl result. If anything at * weird happened with the child processes, TCL_ERROR is returned * and a message is left in the interp's result. * * Side effects: * If the last character of the interp's result is a newline, then it * is removed unless keepNewline is non-zero. File errorId gets * closed, and pidPtr is freed back to the storage allocator. * *---------------------------------------------------------------------- */ int TclCleanupChildren(interp, numPids, pidPtr, errorChan) Tcl_Interp *interp; /* Used for error messages. */ int numPids; /* Number of entries in pidPtr array. */ Tcl_Pid *pidPtr; /* Array of process ids of children. */ Tcl_Channel errorChan; /* Channel for file containing stderr output * from pipeline. NULL means there isn't any * stderr output. */ { int result = TCL_OK; int i, abnormalExit, anyErrorInfo; Tcl_Pid pid; WAIT_STATUS_TYPE waitStatus; CONST char *msg; unsigned long resolvedPid; abnormalExit = 0; for (i = 0; i < numPids; i++) { /* * We need to get the resolved pid before we wait on it as * the windows implimentation of Tcl_WaitPid deletes the * information such that any following calls to TclpGetPid * fail. */ resolvedPid = TclpGetPid(pidPtr[i]); pid = Tcl_WaitPid(pidPtr[i], (int *) &waitStatus, 0); if (pid == (Tcl_Pid) -1) { result = TCL_ERROR; if (interp != (Tcl_Interp *) NULL) { msg = Tcl_PosixError(interp); if (errno == ECHILD) { /* * This changeup in message suggested by Mark Diekhans * to remind people that ECHILD errors can occur on * some systems if SIGCHLD isn't in its default state. */ msg = "child process lost (is SIGCHLD ignored or trapped?)"; } Tcl_AppendResult(interp, "error waiting for process to exit: ", msg, (char *) NULL); } continue; } /* * Create error messages for unusual process exits. An * extra newline gets appended to each error message, but * it gets removed below (in the same fashion that an * extra newline in the command's output is removed). */ if (!WIFEXITED(waitStatus) || (WEXITSTATUS(waitStatus) != 0)) { char msg1[TCL_INTEGER_SPACE], msg2[TCL_INTEGER_SPACE]; result = TCL_ERROR; TclFormatInt(msg1, (long) resolvedPid); if (WIFEXITED(waitStatus)) { if (interp != (Tcl_Interp *) NULL) { TclFormatInt(msg2, WEXITSTATUS(waitStatus)); Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2, (char *) NULL); } abnormalExit = 1; } else if (WIFSIGNALED(waitStatus)) { if (interp != (Tcl_Interp *) NULL) { CONST char *p; p = Tcl_SignalMsg((int) (WTERMSIG(waitStatus))); Tcl_SetErrorCode(interp, "CHILDKILLED", msg1, Tcl_SignalId((int) (WTERMSIG(waitStatus))), p, (char *) NULL); Tcl_AppendResult(interp, "child killed: ", p, "\n", (char *) NULL); } } else if (WIFSTOPPED(waitStatus)) { if (interp != (Tcl_Interp *) NULL) { CONST char *p; p = Tcl_SignalMsg((int) (WSTOPSIG(waitStatus))); Tcl_SetErrorCode(interp, "CHILDSUSP", msg1, Tcl_SignalId((int) (WSTOPSIG(waitStatus))), p, (char *) NULL); Tcl_AppendResult(interp, "child suspended: ", p, "\n", (char *) NULL); } } else { if (interp != (Tcl_Interp *) NULL) { Tcl_AppendResult(interp, "child wait status didn't make sense\n", (char *) NULL); } } } } /* * Read the standard error file. If there's anything there, * then return an error and add the file's contents to the result * string. */ anyErrorInfo = 0; if (errorChan != NULL) { /* * Make sure we start at the beginning of the file. */ if (interp != NULL) { int count; Tcl_Obj *objPtr; Tcl_Seek(errorChan, (Tcl_WideInt)0, SEEK_SET); objPtr = Tcl_NewObj(); count = Tcl_ReadChars(errorChan, objPtr, -1, 0); if (count < 0) { result = TCL_ERROR; Tcl_DecrRefCount(objPtr); Tcl_ResetResult(interp); Tcl_AppendResult(interp, "error reading stderr output file: ", Tcl_PosixError(interp), NULL); } else if (count > 0) { anyErrorInfo = 1; Tcl_SetObjResult(interp, objPtr); result = TCL_ERROR; } else { Tcl_DecrRefCount(objPtr); } } Tcl_Close(NULL, errorChan); } /* * If a child exited abnormally but didn't output any error information * at all, generate an error message here. */ if ((abnormalExit != 0) && (anyErrorInfo == 0) && (interp != NULL)) { Tcl_AppendResult(interp, "child process exited abnormally", (char *) NULL); } return result; } /* *---------------------------------------------------------------------- * * TclCreatePipeline -- * * Given an argc/argv array, instantiate a pipeline of processes * as described by the argv. * * This procedure is unofficially exported for use by BLT. * * Results: * The return value is a count of the number of new processes * created, or -1 if an error occurred while creating the pipeline. * *pidArrayPtr is filled in with the address of a dynamically * allocated array giving the ids of all of the processes. It * is up to the caller to free this array when it isn't needed * anymore. If inPipePtr is non-NULL, *inPipePtr is filled in * with the file id for the input pipe for the pipeline (if any): * the caller must eventually close this file. If outPipePtr * isn't NULL, then *outPipePtr is filled in with the file id * for the output pipe from the pipeline: the caller must close * this file. If errFilePtr isn't NULL, then *errFilePtr is filled * with a file id that may be used to read error output after the * pipeline completes. * * Side effects: * Processes and pipes are created. * *---------------------------------------------------------------------- */ int TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr, outPipePtr, errFilePtr) Tcl_Interp *interp; /* Interpreter to use for error reporting. */ int argc; /* Number of entries in argv. */ CONST char **argv; /* Array of strings describing commands in * pipeline plus I/O redirection with <, * <<, >, etc. Argv[argc] must be NULL. */ Tcl_Pid **pidArrayPtr; /* Word at *pidArrayPtr gets filled in with * address of array of pids for processes * in pipeline (first pid is first process * in pipeline). */ TclFile *inPipePtr; /* If non-NULL, input to the pipeline comes * from a pipe (unless overridden by * redirection in the command). The file * id with which to write to this pipe is * stored at *inPipePtr. NULL means command * specified its own input source. */ TclFile *outPipePtr; /* If non-NULL, output to the pipeline goes * to a pipe, unless overriden by redirection * in the command. The file id with which to * read frome this pipe is stored at * *outPipePtr. NULL means command specified * its own output sink. */ TclFile *errFilePtr; /* If non-NULL, all stderr output from the * pipeline will go to a temporary file * created here, and a descriptor to read * the file will be left at *errFilePtr. * The file will be removed already, so * closing this descriptor will be the end * of the file. If this is NULL, then * all stderr output goes to our stderr. * If the pipeline specifies redirection * then the file will still be created * but it will never get any data. */ { Tcl_Pid *pidPtr = NULL; /* Points to malloc-ed array holding all * the pids of child processes. */ int numPids; /* Actual number of processes that exist * at *pidPtr right now. */ int cmdCount; /* Count of number of distinct commands * found in argc/argv. */ CONST char *inputLiteral = NULL; /* If non-null, then this points to a * string containing input data (specified * via <<) to be piped to the first process * in the pipeline. */ TclFile inputFile = NULL; /* If != NULL, gives file to use as input for * first process in pipeline (specified via < * or <@). */ int inputClose = 0; /* If non-zero, then inputFile should be * closed when cleaning up. */ int inputRelease = 0; TclFile outputFile = NULL; /* Writable file for output from last command * in pipeline (could be file or pipe). NULL * means use stdout. */ int outputClose = 0; /* If non-zero, then outputFile should be * closed when cleaning up. */ int outputRelease = 0; TclFile errorFile = NULL; /* Writable file for error output from all * commands in pipeline. NULL means use * stderr. */ int errorClose = 0; /* If non-zero, then errorFile should be * closed when cleaning up. */ int errorRelease = 0; CONST char *p; CONST char *nextArg; int skip, lastBar, lastArg, i, j, atOK, flags, errorToOutput = 0; Tcl_DString execBuffer; TclFile pipeIn; TclFile curInFile, curOutFile, curErrFile; Tcl_Channel channel; if (inPipePtr != NULL) { *inPipePtr = NULL; } if (outPipePtr != NULL) { *outPipePtr = NULL; } if (errFilePtr != NULL) { *errFilePtr = NULL; } Tcl_DStringInit(&execBuffer); pipeIn = NULL; curInFile = NULL; curOutFile = NULL; numPids = 0; /* * First, scan through all the arguments to figure out the structure * of the pipeline. Process all of the input and output redirection * arguments and remove them from the argument list in the pipeline. * Count the number of distinct processes (it's the number of "|" * arguments plus one) but don't remove the "|" arguments because * they'll be used in the second pass to seperate the individual * child processes. Cannot start the child processes in this pass * because the redirection symbols may appear anywhere in the * command line -- e.g., the '<' that specifies the input to the * entire pipe may appear at the very end of the argument list. */ lastBar = -1; cmdCount = 1; for (i = 0; i < argc; i++) { errorToOutput = 0; skip = 0; p = argv[i]; switch (*p++) { case '|': if (*p == '&') { p++; } if (*p == '\0') { if ((i == (lastBar + 1)) || (i == (argc - 1))) { Tcl_SetResult(interp, "illegal use of | or |& in command", TCL_STATIC); goto error; } } lastBar = i; cmdCount++; break; case '<': if (inputClose != 0) { inputClose = 0; TclpCloseFile(inputFile); } if (inputRelease != 0) { inputRelease = 0; TclpReleaseFile(inputFile); } if (*p == '<') { inputFile = NULL; inputLiteral = p + 1; skip = 1; if (*inputLiteral == '\0') { inputLiteral = ((i + 1) == argc) ? NULL : argv[i + 1]; if (inputLiteral == NULL) { Tcl_AppendResult(interp, "can't specify \"", argv[i], "\" as last word in command", (char *) NULL); goto error; } skip = 2; } } else { nextArg = ((i + 1) == argc) ? NULL : argv[i + 1]; inputLiteral = NULL; inputFile = FileForRedirect(interp, p, 1, argv[i], nextArg, O_RDONLY, &skip, &inputClose, &inputRelease); if (inputFile == NULL) { goto error; } } break; case '>': atOK = 1; flags = O_WRONLY | O_CREAT | O_TRUNC; if (*p == '>') { p++; atOK = 0; /* * Note that the O_APPEND flag only has an effect on POSIX * platforms. On Windows, we just have to carry on regardless. */ flags = O_WRONLY | O_CREAT | O_APPEND; } if (*p == '&') { if (errorClose != 0) { errorClose = 0; TclpCloseFile(errorFile); } errorToOutput = 1; p++; } /* * Close the old output file, but only if the error file is * not also using it. */ if (outputClose != 0) { outputClose = 0; if (errorFile == outputFile) { errorClose = 1; } else { TclpCloseFile(outputFile); } } if (outputRelease != 0) { outputRelease = 0; if (errorFile == outputFile) { errorRelease = 1; } else { TclpReleaseFile(outputFile); } } nextArg = ((i + 1) == argc) ? NULL : argv[i + 1]; outputFile = FileForRedirect(interp, p, atOK, argv[i], nextArg, flags, &skip, &outputClose, &outputRelease); if (outputFile == NULL) { goto error; } if (errorToOutput) { if (errorClose != 0) { errorClose = 0; TclpCloseFile(errorFile); } if (errorRelease != 0) { errorRelease = 0; TclpReleaseFile(errorFile); } errorFile = outputFile; } break; case '2': if (*p != '>') { break; } p++; atOK = 1; flags = O_WRONLY | O_CREAT | O_TRUNC; if (*p == '>') { p++; atOK = 0; flags = O_WRONLY | O_CREAT; } if (errorClose != 0) { errorClose = 0; TclpCloseFile(errorFile); } if (errorRelease != 0) { errorRelease = 0; TclpReleaseFile(errorFile); } if (atOK && p[0] == '@' && p[1] == '1' && p[2] == '\0') { /* * Special case handling of 2>@1 to redirect stderr to the * exec/open output pipe as well. This is meant for the end * of the command string, otherwise use |& between commands. */ if (i != argc - 1) { Tcl_AppendResult(interp, "must specify \"", argv[i], "\" as last word in command", (char *) NULL); goto error; } errorFile = outputFile; errorToOutput = 2; skip = 1; } else { nextArg = ((i + 1) == argc) ? NULL : argv[i + 1]; errorFile = FileForRedirect(interp, p, atOK, argv[i], nextArg, flags, &skip, &errorClose, &errorRelease); if (errorFile == NULL) { goto error; } } break; } if (skip != 0) { for (j = i + skip; j < argc; j++) { argv[j - skip] = argv[j]; } argc -= skip; i -= 1; } } if (inputFile == NULL) { if (inputLiteral != NULL) { /* * The input for the first process is immediate data coming from * Tcl. Create a temporary file for it and put the data into the * file. */ inputFile = TclpCreateTempFile(inputLiteral); if (inputFile == NULL) { Tcl_AppendResult(interp, "couldn't create input file for command: ", Tcl_PosixError(interp), (char *) NULL); goto error; } inputClose = 1; } else if (inPipePtr != NULL) { /* * The input for the first process in the pipeline is to * come from a pipe that can be written from by the caller. */ if (TclpCreatePipe(&inputFile, inPipePtr) == 0) { Tcl_AppendResult(interp, "couldn't create input pipe for command: ", Tcl_PosixError(interp), (char *) NULL); goto error; } inputClose = 1; } else { /* * The input for the first process comes from stdin. */ channel = Tcl_GetStdChannel(TCL_STDIN); if (channel != NULL) { inputFile = TclpMakeFile(channel, TCL_READABLE); if (inputFile != NULL) { inputRelease = 1; } } } } if (outputFile == NULL) { if (outPipePtr != NULL) { /* * Output from the last process in the pipeline is to go to a * pipe that can be read by the caller. */ if (TclpCreatePipe(outPipePtr, &outputFile) == 0) { Tcl_AppendResult(interp, "couldn't create output pipe for command: ", Tcl_PosixError(interp), (char *) NULL); goto error; } outputClose = 1; } else { /* * The output for the last process goes to stdout. */ channel = Tcl_GetStdChannel(TCL_STDOUT); if (channel) { outputFile = TclpMakeFile(channel, TCL_WRITABLE); if (outputFile != NULL) { outputRelease = 1; } } } } if (errorFile == NULL) { if (errorToOutput == 2) { /* * Handle 2>@1 special case at end of cmd line */ errorFile = outputFile; } else if (errFilePtr != NULL) { /* * Set up the standard error output sink for the pipeline, if * requested. Use a temporary file which is opened, then deleted. * Could potentially just use pipe, but if it filled up it could * cause the pipeline to deadlock: we'd be waiting for processes * to complete before reading stderr, and processes couldn't * complete because stderr was backed up. */ errorFile = TclpCreateTempFile(NULL); if (errorFile == NULL) { Tcl_AppendResult(interp, "couldn't create error file for command: ", Tcl_PosixError(interp), (char *) NULL); goto error; } *errFilePtr = errorFile; } else { /* * Errors from the pipeline go to stderr. */ channel = Tcl_GetStdChannel(TCL_STDERR); if (channel) { errorFile = TclpMakeFile(channel, TCL_WRITABLE); if (errorFile != NULL) { errorRelease = 1; } } } } /* * Scan through the argc array, creating a process for each * group of arguments between the "|" characters. */ Tcl_ReapDetachedProcs(); pidPtr = (Tcl_Pid *) ckalloc((unsigned) (cmdCount * sizeof(Tcl_Pid))); curInFile = inputFile; for (i = 0; i < argc; i = lastArg + 1) { int result, joinThisError; Tcl_Pid pid; CONST char *oldName; /* * Convert the program name into native form. */ if (Tcl_TranslateFileName(interp, argv[i], &execBuffer) == NULL) { goto error; } /* * Find the end of the current segment of the pipeline. */ joinThisError = 0; for (lastArg = i; lastArg < argc; lastArg++) { if (argv[lastArg][0] == '|') { if (argv[lastArg][1] == '\0') { break; } if ((argv[lastArg][1] == '&') && (argv[lastArg][2] == '\0')) { joinThisError = 1; break; } } } /* * If this is the last segment, use the specified outputFile. * Otherwise create an intermediate pipe. pipeIn will become the * curInFile for the next segment of the pipe. */ if (lastArg == argc) { curOutFile = outputFile; } else { argv[lastArg] = NULL; if (TclpCreatePipe(&pipeIn, &curOutFile) == 0) { Tcl_AppendResult(interp, "couldn't create pipe: ", Tcl_PosixError(interp), (char *) NULL); goto error; } } if (joinThisError != 0) { curErrFile = curOutFile; } else { curErrFile = errorFile; } /* * Restore argv[i], since a caller wouldn't expect the contents of * argv to be modified. */ oldName = argv[i]; argv[i] = Tcl_DStringValue(&execBuffer); result = TclpCreateProcess(interp, lastArg - i, argv + i, curInFile, curOutFile, curErrFile, &pid); argv[i] = oldName; if (result != TCL_OK) { goto error; } Tcl_DStringFree(&execBuffer); pidPtr[numPids] = pid; numPids++; /* * Close off our copies of file descriptors that were set up for * this child, then set up the input for the next child. */ if ((curInFile != NULL) && (curInFile != inputFile)) { TclpCloseFile(curInFile); } curInFile = pipeIn; pipeIn = NULL; if ((curOutFile != NULL) && (curOutFile != outputFile)) { TclpCloseFile(curOutFile); } curOutFile = NULL; } *pidArrayPtr = pidPtr; /* * All done. Cleanup open files lying around and then return. */ cleanup: Tcl_DStringFree(&execBuffer); if (inputClose) { TclpCloseFile(inputFile); } else if (inputRelease) { TclpReleaseFile(inputFile); } if (outputClose) { TclpCloseFile(outputFile); } else if (outputRelease) { TclpReleaseFile(outputFile); } if (errorClose) { TclpCloseFile(errorFile); } else if (errorRelease) { TclpReleaseFile(errorFile); } return numPids; /* * An error occurred. There could have been extra files open, such * as pipes between children. Clean them all up. Detach any child * processes that have been created. */ error: if (pipeIn != NULL) { TclpCloseFile(pipeIn); } if ((curOutFile != NULL) && (curOutFile != outputFile)) { TclpCloseFile(curOutFile); } if ((curInFile != NULL) && (curInFile != inputFile)) { TclpCloseFile(curInFile); } if ((inPipePtr != NULL) && (*inPipePtr != NULL)) { TclpCloseFile(*inPipePtr); *inPipePtr = NULL; } if ((outPipePtr != NULL) && (*outPipePtr != NULL)) { TclpCloseFile(*outPipePtr); *outPipePtr = NULL; } if ((errFilePtr != NULL) && (*errFilePtr != NULL)) { TclpCloseFile(*errFilePtr); *errFilePtr = NULL; } if (pidPtr != NULL) { for (i = 0; i < numPids; i++) { if (pidPtr[i] != (Tcl_Pid) -1) { Tcl_DetachPids(1, &pidPtr[i]); } } ckfree((char *) pidPtr); } numPids = -1; goto cleanup; } /* *---------------------------------------------------------------------- * * Tcl_OpenCommandChannel -- * * Opens an I/O channel to one or more subprocesses specified * by argc and argv. The flags argument determines the * disposition of the stdio handles. If the TCL_STDIN flag is * set then the standard input for the first subprocess will * be tied to the channel: writing to the channel will provide * input to the subprocess. If TCL_STDIN is not set, then * standard input for the first subprocess will be the same as * this application's standard input. If TCL_STDOUT is set then * standard output from the last subprocess can be read from the * channel; otherwise it goes to this application's standard * output. If TCL_STDERR is set, standard error output for all * subprocesses is returned to the channel and results in an error * when the channel is closed; otherwise it goes to this * application's standard error. If TCL_ENFORCE_MODE is not set, * then argc and argv can redirect the stdio handles to override * TCL_STDIN, TCL_STDOUT, and TCL_STDERR; if it is set, then it * is an error for argc and argv to override stdio channels for * which TCL_STDIN, TCL_STDOUT, and TCL_STDERR have been set. * * Results: * A new command channel, or NULL on failure with an error * message left in interp. * * Side effects: * Creates processes, opens pipes. * *---------------------------------------------------------------------- */ Tcl_Channel Tcl_OpenCommandChannel(interp, argc, argv, flags) Tcl_Interp *interp; /* Interpreter for error reporting. Can * NOT be NULL. */ int argc; /* How many arguments. */ CONST char **argv; /* Array of arguments for command pipe. */ int flags; /* Or'ed combination of TCL_STDIN, TCL_STDOUT, * TCL_STDERR, and TCL_ENFORCE_MODE. */ { TclFile *inPipePtr, *outPipePtr, *errFilePtr; TclFile inPipe, outPipe, errFile; int numPids; Tcl_Pid *pidPtr; Tcl_Channel channel; inPipe = outPipe = errFile = NULL; inPipePtr = (flags & TCL_STDIN) ? &inPipe : NULL; outPipePtr = (flags & TCL_STDOUT) ? &outPipe : NULL; errFilePtr = (flags & TCL_STDERR) ? &errFile : NULL; numPids = TclCreatePipeline(interp, argc, argv, &pidPtr, inPipePtr, outPipePtr, errFilePtr); if (numPids < 0) { goto error; } /* * Verify that the pipes that were created satisfy the * readable/writable constraints. */ if (flags & TCL_ENFORCE_MODE) { if ((flags & TCL_STDOUT) && (outPipe == NULL)) { Tcl_AppendResult(interp, "can't read output from command:", " standard output was redirected", (char *) NULL); goto error; } if ((flags & TCL_STDIN) && (inPipe == NULL)) { Tcl_AppendResult(interp, "can't write input to command:", " standard input was redirected", (char *) NULL); goto error; } } channel = TclpCreateCommandChannel(outPipe, inPipe, errFile, numPids, pidPtr); if (channel == (Tcl_Channel) NULL) { Tcl_AppendResult(interp, "pipe for command could not be created", (char *) NULL); goto error; } return channel; error: if (numPids > 0) { Tcl_DetachPids(numPids, pidPtr); ckfree((char *) pidPtr); } if (inPipe != NULL) { TclpCloseFile(inPipe); } if (outPipe != NULL) { TclpCloseFile(outPipe); } if (errFile != NULL) { TclpCloseFile(errFile); } return NULL; }