Logo Search packages:      
Sourcecode: tcl8.3 version File versions  Download package

tclPipe.c

/* 
 * 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.3 1999/04/16 00:46:51 stanton 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,
                  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 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. */
    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;

    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;
    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[TCL_INTEGER_SPACE], msg2[TCL_INTEGER_SPACE];

          result = TCL_ERROR;
          TclFormatInt(msg1, (long) TclpGetPid(pid));
          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) {
                    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.
       */

        if (interp != NULL) {
          int count;
          Tcl_Obj *objPtr;
          
          Tcl_Seek(errorChan, 0L, 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. */
    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);
          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);
          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;
      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;
            }
          }
      }
      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;
      }

      /*
       * 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. */
    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;
}

Generated by  Doxygen 1.6.0   Back to index