/* * tclIOUtil.c -- * * This file contains a collection of utility procedures that * are shared by the platform specific IO drivers. * * Parts of this file are based on code contributed by Karl * Lehenbauer, Mark Diekhans and Peter da Silva. * * Copyright (c) 1991-1994 The Regents of the University of California. * Copyright (c) 1994-1996 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: @(#) tclIOUtil.c 1.128 96/10/02 12:25:36 */ #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, char *nextArg, int flags, int *skipPtr, int *closePtr, Tcl_DString *namePtr)); /* *---------------------------------------------------------------------- * * 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, nextArg, flags, skipPtr, closePtr, namePtr) 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. */ Tcl_DString *namePtr; /* Pointer to an initialized Tcl_DString that * is filled with the name of the file that * was opened. Unmodified if spec refers * to a channel. */ { int writing = (flags & O_WRONLY); Tcl_Channel chan; Tcl_File 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 = 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 { char *name; if (*spec == '\0') { spec = nextArg; if (spec == NULL) { goto badLastArg; } *skipPtr = 2; } name = Tcl_TranslateFileName(interp, spec, namePtr); if (name != NULL) { file = TclOpenFile(name, flags); } else { file = NULL; } if (file == NULL) { Tcl_AppendResult(interp, "couldn't ", ((writing) ? "write" : "read"), " file \"", spec, "\": ", Tcl_PosixError(interp), (char *) NULL); Tcl_DStringFree(namePtr); return NULL; } *closePtr = 1; } return file; badLastArg: Tcl_AppendResult(interp, "can't specify \"", arg, "\" as last word in command", (char *) NULL); return NULL; } /* *---------------------------------------------------------------------- * * TclGetOpenMode -- * * Description: * Computes a POSIX mode mask for opening a file, from a given string, * and also sets a flag to indicate whether the caller should seek to * EOF after opening the file. * * Results: * On success, returns mode to pass to "open". If an error occurs, the * returns -1 and if interp is not NULL, sets interp->result to an * error message. * * Side effects: * Sets the integer referenced by seekFlagPtr to 1 to tell the caller * to seek to EOF after opening the file. * * Special note: * This code is based on a prototype implementation contributed * by Mark Diekhans. * *---------------------------------------------------------------------- */ int TclGetOpenMode(interp, string, seekFlagPtr) Tcl_Interp *interp; /* Interpreter to use for error * reporting - may be NULL. */ char *string; /* Mode string, e.g. "r+" or * "RDONLY CREAT". */ int *seekFlagPtr; /* Set this to 1 if the caller * should seek to EOF during the * opening of the file. */ { int mode, modeArgc, c, i, gotRW; char **modeArgv, *flag; #define RW_MODES (O_RDONLY|O_WRONLY|O_RDWR) /* * Check for the simpler fopen-like access modes (e.g. "r"). They * are distinguished from the POSIX access modes by the presence * of a lower-case first letter. */ *seekFlagPtr = 0; mode = 0; if (islower(UCHAR(string[0]))) { switch (string[0]) { case 'r': mode = O_RDONLY; break; case 'w': mode = O_WRONLY|O_CREAT|O_TRUNC; break; case 'a': mode = O_WRONLY|O_CREAT; *seekFlagPtr = 1; break; default: error: if (interp != (Tcl_Interp *) NULL) { Tcl_AppendResult(interp, "illegal access mode \"", string, "\"", (char *) NULL); } return -1; } if (string[1] == '+') { mode &= ~(O_RDONLY|O_WRONLY); mode |= O_RDWR; if (string[2] != 0) { goto error; } } else if (string[1] != 0) { goto error; } return mode; } /* * The access modes are specified using a list of POSIX modes * such as O_CREAT. * * IMPORTANT NOTE: We rely on Tcl_SplitList working correctly when * a NULL interpreter is passed in. */ if (Tcl_SplitList(interp, string, &modeArgc, &modeArgv) != TCL_OK) { if (interp != (Tcl_Interp *) NULL) { Tcl_AddErrorInfo(interp, "\n while processing open access modes \""); Tcl_AddErrorInfo(interp, string); Tcl_AddErrorInfo(interp, "\""); } return -1; } gotRW = 0; for (i = 0; i < modeArgc; i++) { flag = modeArgv[i]; c = flag[0]; if ((c == 'R') && (strcmp(flag, "RDONLY") == 0)) { mode = (mode & ~RW_MODES) | O_RDONLY; gotRW = 1; } else if ((c == 'W') && (strcmp(flag, "WRONLY") == 0)) { mode = (mode & ~RW_MODES) | O_WRONLY; gotRW = 1; } else if ((c == 'R') && (strcmp(flag, "RDWR") == 0)) { mode = (mode & ~RW_MODES) | O_RDWR; gotRW = 1; } else if ((c == 'A') && (strcmp(flag, "APPEND") == 0)) { mode |= O_APPEND; *seekFlagPtr = 1; } else if ((c == 'C') && (strcmp(flag, "CREAT") == 0)) { mode |= O_CREAT; } else if ((c == 'E') && (strcmp(flag, "EXCL") == 0)) { mode |= O_EXCL; } else if ((c == 'N') && (strcmp(flag, "NOCTTY") == 0)) { #ifdef O_NOCTTY mode |= O_NOCTTY; #else if (interp != (Tcl_Interp *) NULL) { Tcl_AppendResult(interp, "access mode \"", flag, "\" not supported by this system", (char *) NULL); } ckfree((char *) modeArgv); return -1; #endif } else if ((c == 'N') && (strcmp(flag, "NONBLOCK") == 0)) { #if defined(O_NDELAY) || defined(O_NONBLOCK) # ifdef O_NONBLOCK mode |= O_NONBLOCK; # else mode |= O_NDELAY; # endif #else if (interp != (Tcl_Interp *) NULL) { Tcl_AppendResult(interp, "access mode \"", flag, "\" not supported by this system", (char *) NULL); } ckfree((char *) modeArgv); return -1; #endif } else if ((c == 'T') && (strcmp(flag, "TRUNC") == 0)) { mode |= O_TRUNC; } else { if (interp != (Tcl_Interp *) NULL) { Tcl_AppendResult(interp, "invalid access mode \"", flag, "\": must be RDONLY, WRONLY, RDWR, APPEND, CREAT", " EXCL, NOCTTY, NONBLOCK, or TRUNC", (char *) NULL); } ckfree((char *) modeArgv); return -1; } } ckfree((char *) modeArgv); if (!gotRW) { if (interp != (Tcl_Interp *) NULL) { Tcl_AppendResult(interp, "access mode must include either", " RDONLY, WRONLY, or RDWR", (char *) NULL); } return -1; } return mode; } /* *---------------------------------------------------------------------- * * Tcl_EvalFile -- * * Read in a file and process the entire file as one gigantic * Tcl command. * * Results: * A standard Tcl result, which is either the result of executing * the file or an error indicating why the file couldn't be read. * * Side effects: * Depends on the commands in the file. * *---------------------------------------------------------------------- */ int Tcl_EvalFile(interp, fileName) Tcl_Interp *interp; /* Interpreter in which to process file. */ char *fileName; /* Name of file to process. Tilde-substitution * will be performed on this name. */ { int result; struct stat statBuf; char *cmdBuffer = (char *) NULL; char *oldScriptFile = (char *) NULL; Interp *iPtr = (Interp *) interp; Tcl_DString buffer; char *nativeName = (char *) NULL; Tcl_Channel chan = (Tcl_Channel) NULL; Tcl_ResetResult(interp); oldScriptFile = iPtr->scriptFile; iPtr->scriptFile = fileName; Tcl_DStringInit(&buffer); nativeName = Tcl_TranslateFileName(interp, fileName, &buffer); if (nativeName == NULL) { goto error; } /* * If Tcl_TranslateFileName didn't already copy the file name, do it * here. This way we don't depend on fileName staying constant * throughout the execution of the script (e.g., what if it happens * to point to a Tcl variable that the script could change?). */ if (nativeName != Tcl_DStringValue(&buffer)) { Tcl_DStringSetLength(&buffer, 0); Tcl_DStringAppend(&buffer, nativeName, -1); nativeName = Tcl_DStringValue(&buffer); } if (stat(nativeName, &statBuf) == -1) { Tcl_SetErrno(errno); Tcl_AppendResult(interp, "couldn't read file \"", fileName, "\": ", Tcl_PosixError(interp), (char *) NULL); goto error; } chan = Tcl_OpenFileChannel(interp, nativeName, "r", 0644); if (chan == (Tcl_Channel) NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "couldn't read file \"", fileName, "\": ", Tcl_PosixError(interp), (char *) NULL); goto error; } cmdBuffer = (char *) ckalloc((unsigned) statBuf.st_size+1); result = Tcl_Read(chan, cmdBuffer, statBuf.st_size); if (result < 0) { Tcl_Close(interp, chan); Tcl_AppendResult(interp, "couldn't read file \"", fileName, "\": ", Tcl_PosixError(interp), (char *) NULL); goto error; } cmdBuffer[result] = 0; if (Tcl_Close(interp, chan) != TCL_OK) { goto error; } result = Tcl_Eval(interp, cmdBuffer); if (result == TCL_RETURN) { result = TclUpdateReturnInfo(iPtr); } else if (result == TCL_ERROR) { char msg[200]; /* * Record information telling where the error occurred. */ sprintf(msg, "\n (file \"%.150s\" line %d)", fileName, interp->errorLine); Tcl_AddErrorInfo(interp, msg); } iPtr->scriptFile = oldScriptFile; ckfree(cmdBuffer); Tcl_DStringFree(&buffer); return result; error: if (cmdBuffer != (char *) NULL) { ckfree(cmdBuffer); } iPtr->scriptFile = oldScriptFile; Tcl_DStringFree(&buffer); return TCL_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((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. * * 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 *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. */ Tcl_File inputFile = NULL; /* If != NULL, gives file to use as input for * first process in pipeline (specified via < * or <@). */ Tcl_DString inputFileName; /* If non-empty, gives name of file that * corresponds to inputFile. */ int inputClose = 0; /* If non-zero, then inputFile should be * closed when cleaning up. */ Tcl_File outputFile = NULL; /* Writable file for output from last command * in pipeline (could be file or pipe). NULL * means use stdout. */ Tcl_DString outputFileName; /* If non-empty, gives name of file that * corresponds to outputFile. */ int outputClose = 0; /* If non-zero, then outputFile should be * closed when cleaning up. */ Tcl_File errorFile = NULL; /* Writable file for error output from all * commands in pipeline. NULL means use * stderr. */ Tcl_DString errorFileName; /* If non-empty, gives name of file that * corresponds to errorFile. */ int errorClose = 0; /* If non-zero, then errorFile should be * closed when cleaning up. */ char *p; int skip, lastBar, lastArg, i, j, atOK, flags, errorToOutput; Tcl_DString execBuffer; Tcl_File pipeIn; Tcl_File curInFile, curOutFile, curErrFile; char *curInFileName, *curOutFileName, *curErrFileName; Tcl_Channel channel; if (inPipePtr != NULL) { *inPipePtr = NULL; } if (outPipePtr != NULL) { *outPipePtr = NULL; } if (errFilePtr != NULL) { *errFilePtr = NULL; } Tcl_DStringInit(&inputFileName); Tcl_DStringInit(&outputFileName); Tcl_DStringInit(&errorFileName); Tcl_DStringInit(&execBuffer); pipeIn = NULL; curInFile = NULL; curOutFile = NULL; curErrFile = NULL; numPids = 0; pidPtr = 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 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))) { interp->result = "illegal use of | or |& in command"; goto error; } } lastBar = i; cmdCount++; break; case '<': if (inputClose != 0) { inputClose = 0; Tcl_DStringFree(&inputFileName); TclCloseFile(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, &inputFileName); 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; Tcl_DStringFree(&errorFileName); TclCloseFile(errorFile); } errorToOutput = 1; p++; } if (outputClose != 0) { outputClose = 0; Tcl_DStringFree(&outputFileName); TclCloseFile(outputFile); } outputFile = FileForRedirect(interp, p, atOK, argv[i], argv[i + 1], flags, &skip, &outputClose, &outputFileName); if (outputFile == NULL) { goto error; } if (atOK == 0) { TclSeekFile(outputFile, 0, SEEK_END); } if (errorToOutput) { errorClose = 0; 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; Tcl_DStringFree(&errorFileName); TclCloseFile(errorFile); } errorFile = FileForRedirect(interp, p, atOK, argv[i], argv[i + 1], flags, &skip, &errorClose, &errorFileName); if (errorFile == NULL) { goto error; } if (atOK == 0) { TclSeekFile(errorFile, 0, SEEK_END); } 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 = TclCreateTempFile(inputLiteral, &inputFileName); 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 (TclCreatePipe(&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 = Tcl_GetChannelFile(channel, TCL_READABLE); } } } 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 (TclCreatePipe(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 = Tcl_GetChannelFile(channel, TCL_WRITABLE); } } } 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 = TclCreateTempFile(NULL, &errorFileName); 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 = Tcl_GetChannelFile(channel, TCL_WRITABLE); } } } /* * Scan through the argc array, creating a process for each * group of arguments between the "|" characters. */ Tcl_ReapDetachedProcs(); pidPtr = (int *) ckalloc((unsigned) (cmdCount * sizeof(int))); curInFile = inputFile; curInFileName = Tcl_DStringValue(&inputFileName); if (curInFileName[0] == '\0') { curInFileName = NULL; } for (i = 0; i < argc; i = lastArg + 1) { int joinThisError, 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; curOutFileName = Tcl_DStringValue(&outputFileName); if (curOutFileName[0] == '\0') { curOutFileName = NULL; } } else { if (TclCreatePipe(&pipeIn, &curOutFile) == 0) { Tcl_AppendResult(interp, "couldn't create pipe: ", Tcl_PosixError(interp), (char *) NULL); goto error; } curOutFileName = NULL; } if (joinThisError != 0) { curErrFile = curOutFile; curErrFileName = curOutFileName; } else { curErrFile = errorFile; curErrFileName = Tcl_DStringValue(&errorFileName); if (curErrFileName[0] == '\0') { curErrFileName = NULL; } } if (TclpCreateProcess(interp, lastArg - i, argv + i, curInFile, curOutFile, curErrFile, curInFileName, curOutFileName, curErrFileName, &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)) { TclCloseFile(curInFile); } curInFile = pipeIn; curInFileName = NULL; pipeIn = NULL; if ((curOutFile != NULL) && (curOutFile != outputFile)) { TclCloseFile(curOutFile); } curOutFile = NULL; } *pidArrayPtr = pidPtr; /* * All done. Cleanup open files lying around and then return. */ cleanup: Tcl_DStringFree(&inputFileName); Tcl_DStringFree(&outputFileName); Tcl_DStringFree(&errorFileName); Tcl_DStringFree(&execBuffer); if (inputClose) { TclCloseFile(inputFile); } if (outputClose) { TclCloseFile(outputFile); } if (errorClose) { 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 (pipeIn != NULL) { TclCloseFile(pipeIn); } if ((curOutFile != NULL) && (curOutFile != outputFile)) { TclCloseFile(curOutFile); } if ((curInFile != NULL) && (curInFile != inputFile)) { TclCloseFile(curInFile); } 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 * currently the global variable "errno" but could in the future * change to something else. * * Results: * The value of the Tcl error code variable. * * Side effects: * None. Note that the value of the Tcl error code variable is * UNDEFINED if a call to Tcl_SetErrno did not precede this call. * *---------------------------------------------------------------------- */ int Tcl_GetErrno() { return errno; } /* *---------------------------------------------------------------------- * * Tcl_SetErrno -- * * Sets the Tcl error code variable to the supplied value. * * Results: * None. * * Side effects: * Modifies the value of the Tcl error code variable. * *---------------------------------------------------------------------- */ void Tcl_SetErrno(err) int err; /* The new value. */ { errno = err; } /* *---------------------------------------------------------------------- * * Tcl_PosixError -- * * This procedure is typically called after UNIX kernel calls * return errors. It stores machine-readable information about * the error in $errorCode returns an information string for * the caller's use. * * Results: * The return value is a human-readable string describing the * error. * * Side effects: * The global variable $errorCode is reset. * *---------------------------------------------------------------------- */ char * Tcl_PosixError(interp) Tcl_Interp *interp; /* Interpreter whose $errorCode variable * is to be changed. */ { char *id, *msg; msg = Tcl_ErrnoMsg(errno); id = Tcl_ErrnoId(); 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; }