summaryrefslogtreecommitdiffstats
path: root/generic/tclPipe.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclPipe.c')
-rw-r--r--generic/tclPipe.c1051
1 files changed, 1051 insertions, 0 deletions
diff --git a/generic/tclPipe.c b/generic/tclPipe.c
new file mode 100644
index 0000000..bf606cc
--- /dev/null
+++ b/generic/tclPipe.c
@@ -0,0 +1,1051 @@
+/*
+ * 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.
+ *
+ * SCCS: @(#) tclPipe.c 1.8 97/06/20 13:26:45
+ */
+
+#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. */
+
+/*
+ * Declarations for local procedures defined in this file:
+ */
+
+static TclFile FileForRedirect _ANSI_ARGS_((Tcl_Interp *interp,
+ char *spec, int atOk, char *arg, 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 interp->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. */
+ char *spec; /* Points to character just after
+ * redirection character. */
+ char *arg; /* Pointer to entire argument containing
+ * spec: used for error reporting. */
+ int atOK; /* Non-zero means that '@' notation can be
+ * used to specify a channel, zero means that
+ * it isn't. */
+ 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 {
+ 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;
+
+ for (i = 0; i < numPids; i++) {
+ detPtr = (Detached *) ckalloc(sizeof(Detached));
+ detPtr->pid = pidPtr[i];
+ detPtr->nextPtr = detList;
+ detList = detPtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+
+ 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;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 interp->result.
+ *
+ * Side effects:
+ * If the last character of interp->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;
+ char *msg;
+
+ abnormalExit = 0;
+ for (i = 0; i < numPids; 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[20], msg2[20];
+
+ result = TCL_ERROR;
+ sprintf(msg1, "%ld", TclpGetPid(pid));
+ if (WIFEXITED(waitStatus)) {
+ if (interp != (Tcl_Interp *) NULL) {
+ sprintf(msg2, "%d", WEXITSTATUS(waitStatus));
+ Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2,
+ (char *) NULL);
+ }
+ abnormalExit = 1;
+ } else if (WIFSIGNALED(waitStatus)) {
+ if (interp != (Tcl_Interp *) NULL) {
+ 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) {
+ 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.
+ */
+
+ Tcl_Seek(errorChan, 0L, SEEK_SET);
+
+ if (interp != (Tcl_Interp *) NULL) {
+ while (1) {
+#define BUFFER_SIZE 1000
+ char buffer[BUFFER_SIZE+1];
+ int count;
+
+ count = Tcl_Read(errorChan, buffer, BUFFER_SIZE);
+ if (count == 0) {
+ break;
+ }
+ result = TCL_ERROR;
+ if (count < 0) {
+ Tcl_AppendResult(interp,
+ "error reading stderr output file: ",
+ Tcl_PosixError(interp), (char *) NULL);
+ break; /* out of the "while (1)" loop. */
+ }
+ buffer[count] = 0;
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ anyErrorInfo = 1;
+ }
+ }
+
+ Tcl_Close((Tcl_Interp *) NULL, errorChan);
+ }
+
+ /*
+ * If a child exited abnormally but didn't output any error information
+ * at all, generate an error message here.
+ */
+
+ if (abnormalExit && !anyErrorInfo && (interp != (Tcl_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. */
+ 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. */
+ 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;
+ char *p;
+ int skip, lastBar, lastArg, i, j, atOK, flags, errorToOutput;
+ 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++) {
+ 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 = 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 {
+ inputLiteral = NULL;
+ inputFile = FileForRedirect(interp, p, 1, argv[i],
+ argv[i + 1], O_RDONLY, &skip, &inputClose, &inputRelease);
+ if (inputFile == NULL) {
+ goto error;
+ }
+ }
+ break;
+
+ case '>':
+ atOK = 1;
+ flags = O_WRONLY | O_CREAT | O_TRUNC;
+ errorToOutput = 0;
+ if (*p == '>') {
+ p++;
+ atOK = 0;
+ flags = O_WRONLY | O_CREAT;
+ }
+ 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);
+ }
+ }
+ outputFile = FileForRedirect(interp, p, atOK, argv[i],
+ argv[i + 1], 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);
+ }
+ errorFile = FileForRedirect(interp, p, atOK, argv[i],
+ argv[i + 1], 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, NULL);
+ 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 (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, 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 joinThisError;
+ Tcl_Pid pid;
+
+ /*
+ * Convert the program name into native form.
+ */
+
+ argv[i] = Tcl_TranslateFileName(interp, argv[i], &execBuffer);
+ if (argv[i] == 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;
+ }
+ }
+ }
+ argv[lastArg] = NULL;
+
+ /*
+ * 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 {
+ 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;
+ }
+
+ if (TclpCreateProcess(interp, lastArg - i, argv + i,
+ curInFile, curOutFile, curErrFile, &pid) != 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. */
+ 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;
+}