diff options
Diffstat (limited to 'contrib/tcl/generic/tclIOUtil.c')
| -rw-r--r-- | contrib/tcl/generic/tclIOUtil.c | 917 |
1 files changed, 4 insertions, 913 deletions
diff --git a/contrib/tcl/generic/tclIOUtil.c b/contrib/tcl/generic/tclIOUtil.c index f42e16bbd634f..cb2bd94c017fe 100644 --- a/contrib/tcl/generic/tclIOUtil.c +++ b/contrib/tcl/generic/tclIOUtil.c @@ -13,151 +13,12 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * SCCS: @(#) tclIOUtil.c 1.123 96/04/29 14:08:24 + * SCCS: @(#) tclIOUtil.c 1.132 97/04/23 16:21:42 */ #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 { - int 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 Tcl_File FileForRedirect _ANSI_ARGS_((Tcl_Interp *interp, - char *spec, int atOk, char *arg, int flags, - char *nextArg, int *skipPtr, int *closePtr)); - -/* - *---------------------------------------------------------------------- - * - * 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 Tcl_File -FileForRedirect(interp, spec, atOk, arg, flags, nextArg, skipPtr, closePtr) - Tcl_Interp *interp; /* Intepreter to use for error - * reporting. */ - register char *spec; /* Points to character just after - * redirection character. */ - int atOk; /* Non-zero means '@' notation is - * OK, zero means it isn't. */ - char *arg; /* Pointer to entire argument - * containing spec: used for error - * reporting. */ - int flags; /* Flags to use for opening file. */ - char *nextArg; /* Next argument in argc/argv - * array, if needed for file name. - * May be NULL. */ - int *skipPtr; /* This value is incremented if - * nextArg is used for redirection - * spec. */ - int *closePtr; /* This value is set to 1 if the file - * that's returned must be closed, 0 - * if it was specified with "@" so - * it must be left open. */ -{ - int writing = (flags & O_WRONLY); - Tcl_Channel chan; - Tcl_File file; - - if (atOk && (*spec == '@')) { - spec++; - if (*spec == 0) { - spec = nextArg; - if (spec == NULL) { - goto badLastArg; - } - *skipPtr += 1; - } - chan = Tcl_GetChannel(interp, spec, NULL); - if (chan == (Tcl_Channel) NULL) { - return NULL; - } - *closePtr = 0; - file = Tcl_GetChannelFile(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; - } - 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 { - Tcl_DString buffer; - char *name; - - if (*spec == 0) { - spec = nextArg; - if (spec == NULL) { - goto badLastArg; - } - *skipPtr += 1; - } - name = Tcl_TranslateFileName(interp, spec, &buffer); - if (name) { - file = TclOpenFile(name, flags); - } else { - file = NULL; - } - Tcl_DStringFree(&buffer); - 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; -} /* *---------------------------------------------------------------------- @@ -354,11 +215,11 @@ Tcl_EvalFile(interp, fileName) int result; struct stat statBuf; char *cmdBuffer = (char *) NULL; - char *oldScriptFile = (char *) NULL; + char *oldScriptFile; Interp *iPtr = (Interp *) interp; Tcl_DString buffer; - char *nativeName = (char *) NULL; - Tcl_Channel chan = (Tcl_Channel) NULL; + char *nativeName; + Tcl_Channel chan; Tcl_ResetResult(interp); oldScriptFile = iPtr->scriptFile; @@ -438,670 +299,6 @@ error: /* *---------------------------------------------------------------------- * - * 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. */ - int *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; - int pid; - - for (detPtr = detList, prevPtr = NULL; detPtr != NULL; ) { - pid = (int) Tcl_WaitPid(detPtr->pid, &status, WNOHANG); - if ((pid == 0) || ((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. */ - int *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, pid, abnormalExit, anyErrorInfo; - WAIT_STATUS_TYPE waitStatus; - char *msg; - - abnormalExit = 0; - for (i = 0; i < numPids; i++) { - pid = (int) Tcl_WaitPid(pidPtr[i], (int *) &waitStatus, 0); - if (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, "%d", 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(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. - * - * 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. */ - int **pidArrayPtr; /* Word at *pidArrayPtr gets filled in with - * address of array of pids for processes - * in pipeline (first pid is first process - * in pipeline). */ - Tcl_File *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. */ - Tcl_File *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. */ - Tcl_File *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. */ -{ -#if defined( MAC_TCL ) - Tcl_AppendResult(interp, - "command pipelines not supported on Macintosh OS", NULL); - return -1; -#else /* !MAC_TCL */ - int *pidPtr = NULL; /* Points to malloc-ed array holding all - * the pids of child processes. */ - int numPids = 0; /* Actual number of processes that exist - * at *pidPtr right now. */ - int cmdCount; /* Count of number of distinct commands - * found in argc/argv. */ - char *input = 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. */ - Tcl_File inputFile = NULL; - /* If != NULL, gives file to use as input for - * first process in pipeline (specified via < - * or <@). */ - int closeInput = 0; /* If non-zero, then must close inputId - * when cleaning up (zero means the file needs - * to stay open for some other reason). */ - Tcl_File outputFile = NULL; - /* Writable file for output from last command - * in pipeline (could be file or pipe). NULL - * means use stdout. */ - int closeOutput = 0; /* Non-zero means must close outputId when - * cleaning up (similar to closeInput). */ - Tcl_File errorFile = NULL; - /* Writable file for error output from all - * commands in pipeline. NULL means use - * stderr. */ - int closeError = 0; /* Non-zero means must close errorId when - * cleaning up. */ - int skip; /* Number of arguments to skip (because they - * specify redirection). */ - int lastBar; - int i, j; - char *p; - int hasPipes = TclHasPipes(); - char finalOut[L_tmpnam]; - char intIn[L_tmpnam]; - - finalOut[0] = '\0'; - intIn[0] = '\0'; - - if (inPipePtr != NULL) { - *inPipePtr = NULL; - } - if (outPipePtr != NULL) { - *outPipePtr = NULL; - } - if (errFilePtr != NULL) { - *errFilePtr = NULL; - } - - /* - * 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. - */ - - cmdCount = 1; - lastBar = -1; - for (i = 0; i < argc; i++) { - if ((argv[i][0] == '|') && (((argv[i][1] == 0)) - || ((argv[i][1] == '&') && (argv[i][2] == 0)))) { - if ((i == (lastBar+1)) || (i == (argc-1))) { - interp->result = "illegal use of | or |& in command"; - return -1; - } - lastBar = i; - cmdCount++; - continue; - } else if (argv[i][0] == '<') { - if ((inputFile != NULL) && closeInput) { - TclCloseFile(inputFile); - } - inputFile = NULL; - skip = 1; - if (argv[i][1] == '<') { - input = argv[i]+2; - if (*input == 0) { - input = argv[i+1]; - if (input == 0) { - Tcl_AppendResult(interp, "can't specify \"", argv[i], - "\" as last word in command", (char *) NULL); - goto error; - } - skip = 2; - } - } else { - input = 0; - inputFile = FileForRedirect(interp, argv[i]+1, 1, argv[i], - O_RDONLY, argv[i+1], &skip, &closeInput); - if (inputFile == NULL) { - goto error; - } - - /* When Win32s dies out, this code can be removed */ - if (!hasPipes) { - if (!closeInput) { - Tcl_AppendResult(interp, "redirection with '@'", - " notation is not supported on this system", - (char *) NULL); - goto error; - } - strcpy(intIn, skip == 1 ? argv[i]+1 : argv[i+1]); - } - } - } else if (argv[i][0] == '>') { - int append, useForStdErr, useForStdOut, mustClose, atOk, flags; - Tcl_File file; - - skip = atOk = 1; - append = useForStdErr = 0; - useForStdOut = 1; - if (argv[i][1] == '>') { - p = argv[i] + 2; - append = 1; - atOk = 0; - flags = O_WRONLY|O_CREAT; - } else { - p = argv[i] + 1; - flags = O_WRONLY|O_CREAT|O_TRUNC; - } - if (*p == '&') { - useForStdErr = 1; - p++; - } - file = FileForRedirect(interp, p, atOk, argv[i], flags, argv[i+1], - &skip, &mustClose); - if (file == NULL) { - goto error; - } - - /* When Win32s dies out, this code can be removed */ - if (!hasPipes) { - if (!mustClose) { - Tcl_AppendResult(interp, "redirection with '@'", - " notation is not supported on this system", - (char *) NULL); - goto error; - } - strcpy(finalOut, skip == 1 ? p : argv[i+1]); - } - - if (hasPipes && append) { - TclSeekFile(file, 0L, 2); - } - - /* - * Got the file descriptor. Now use it for standard output, - * standard error, or both, depending on the redirection. - */ - - if (useForStdOut) { - if ((outputFile != NULL) && closeOutput) { - TclCloseFile(outputFile); - } - outputFile = file; - closeOutput = mustClose; - } - if (useForStdErr) { - if ((errorFile != NULL) && closeError) { - TclCloseFile(errorFile); - } - errorFile = file; - closeError = (useForStdOut) ? 0 : mustClose; - } - } else if ((argv[i][0] == '2') && (argv[i][1] == '>')) { - int append, atOk, flags; - - if ((errorFile != NULL) && closeError) { - TclCloseFile(errorFile); - } - skip = 1; - p = argv[i] + 2; - if (*p == '>') { - p++; - append = 1; - atOk = 0; - flags = O_WRONLY|O_CREAT; - } else { - append = 0; - atOk = 1; - flags = O_WRONLY|O_CREAT|O_TRUNC; - } - errorFile = FileForRedirect(interp, p, atOk, argv[i], flags, - argv[i+1], &skip, &closeError); - if (errorFile == NULL) { - goto error; - } - if (hasPipes && append) { - TclSeekFile(errorFile, 0L, 2); - } - } else { - continue; - } - for (j = i+skip; j < argc; j++) { - argv[j-skip] = argv[j]; - } - argc -= skip; - i -= 1; /* Process next arg from same position. */ - } - if (argc == 0) { - interp->result = "didn't specify command to execute"; - return -1; - } - - if ((hasPipes && inputFile == NULL) || (!hasPipes && intIn[0] == '\0')) { - if (input != 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 = TclCreateTempFile(input); - closeInput = 1; - if (inputFile == NULL) { - Tcl_AppendResult(interp, - "couldn't create input file for command: ", - Tcl_PosixError(interp), (char *) NULL); - goto error; - } - } else if (inPipePtr != NULL) { - Tcl_File inPipe, outPipe; - /* - * The input for the first process in the pipeline is to - * come from a pipe that can be written from this end. - */ - - if (!hasPipes || TclCreatePipe(&inPipe, &outPipe) == 0) { - Tcl_AppendResult(interp, - "couldn't create input pipe for command: ", - Tcl_PosixError(interp), (char *) NULL); - goto error; - } - inputFile = inPipe; - closeInput = 1; - *inPipePtr = outPipe; - } - } - - /* - * Set up a pipe to receive output from the pipeline, if no other - * output sink has been specified. - */ - - if ((outputFile == NULL) && (outPipePtr != NULL)) { - if (!hasPipes) { - tmpnam(finalOut); - } else { - Tcl_File inPipe, outPipe; - if (TclCreatePipe(&inPipe, &outPipe) == 0) { - Tcl_AppendResult(interp, - "couldn't create output pipe for command: ", - Tcl_PosixError(interp), (char *) NULL); - goto error; - } - outputFile = outPipe; - closeOutput = 1; - *outPipePtr = inPipe; - } - } - - /* - * 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. - */ - - if (errFilePtr && !errorFile) { - *errFilePtr = TclCreateTempFile(NULL); - if (*errFilePtr == NULL) { - Tcl_AppendResult(interp, - "couldn't create error file for command: ", - Tcl_PosixError(interp), (char *) NULL); - goto error; - } - errorFile = *errFilePtr; - closeError = 0; - } - - /* - * Scan through the argc array, forking off a process for each - * group of arguments between "|" arguments. - */ - - pidPtr = (int *) ckalloc((unsigned) (cmdCount * sizeof(int))); - Tcl_ReapDetachedProcs(); - - if (TclSpawnPipeline(interp, pidPtr, &numPids, argc, argv, - inputFile, outputFile, errorFile, intIn, finalOut) == 0) { - goto error; - } - *pidArrayPtr = pidPtr; - - /* - * All done. Cleanup open files lying around and then return. - */ - -cleanup: - if ((inputFile != NULL) && closeInput) { - TclCloseFile(inputFile); - } - if ((outputFile != NULL) && closeOutput) { - TclCloseFile(outputFile); - } - if ((errorFile != NULL) && closeError) { - TclCloseFile(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 ((inPipePtr != NULL) && (*inPipePtr != NULL)) { - TclCloseFile(*inPipePtr); - *inPipePtr = NULL; - } - if ((outPipePtr != NULL) && (*outPipePtr != NULL)) { - TclCloseFile(*outPipePtr); - *outPipePtr = NULL; - } - if ((errFilePtr != NULL) && (*errFilePtr != NULL)) { - TclCloseFile(*errFilePtr); - *errFilePtr = NULL; - } - if (pidPtr != NULL) { - for (i = 0; i < numPids; i++) { - if (pidPtr[i] != -1) { - Tcl_DetachPids(1, &pidPtr[i]); - } - } - ckfree((char *) pidPtr); - } - numPids = -1; - goto cleanup; -#endif /* !MAC_TCL */ -} - -/* - *---------------------------------------------------------------------- - * * Tcl_GetErrno -- * * Gets the current value of the Tcl error code variable. This is @@ -1179,109 +376,3 @@ Tcl_PosixError(interp) Tcl_SetErrorCode(interp, "POSIX", id, msg, (char *) NULL); return msg; } - -/* - *---------------------------------------------------------------------- - * - * 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. */ -{ - Tcl_File *inPipePtr, *outPipePtr, *errFilePtr; - Tcl_File inPipe, outPipe, errFile; - int numPids, *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 = TclCreateCommandChannel(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) { - TclClosePipeFile(inPipe); - } - if (outPipe != NULL) { - TclClosePipeFile(outPipe); - } - if (errFile != NULL) { - TclClosePipeFile(errFile); - } - return NULL; -} |