/[dtapublic]/projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclpipe.c

Diff of /projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclpipe.c

Parent Directory | Revision Log | View Patch Patch

-revision 64 by dashley,
Sun Oct 30 04:21:11 2016 UTC
+revision 71 by dashley,
Sat Nov  5 11:07:06 2016 UTC
 Line 1
- /*$Header$ */
+ /* $Header$ */
  /*
   * 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.1.1.1 2001/06/13 04:44:53 dtashley 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;
  }
  /* End of tclpipe.c */

 Legend:



Removed from v.64
 


changed lines


 
Added in v.71
 Legend:



Removed from v.64
 


changed lines


 
Added in v.71
-Removed from v.64
+Added in v.71

dashley@gmail.com	ViewVC Help
Powered by ViewVC 1.1.25