tcl/generic/tclPipe.c

   1 /*
   2  * tclPipe.c --
   3  *
   4  *      This file contains the generic portion of the command channel
   5  *      driver as well as various utility routines used in managing
   6  *      subprocesses.
   7  *
   8  * Copyright (c) 1997 by Sun Microsystems, Inc.
   9  *
  10  * See the file "license.terms" for information on usage and redistribution
  11  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12  *
  13  * RCS: @(#) $Id$
  14  */
  15
  16 #include "tclInt.h"
  17 #include "tclPort.h"
  18
  19 /*
  20  * A linked list of the following structures is used to keep track
  21  * of child processes that have been detached but haven't exited
  22  * yet, so we can make sure that they're properly "reaped" (officially
  23  * waited for) and don't lie around as zombies cluttering the
  24  * system.
  25  */
  26
  27 typedef struct Detached {
  28     Tcl_Pid pid;                        /* Id of process that's been detached
  29                                          * but isn't known to have exited. */
  30     struct Detached *nextPtr;           /* Next in list of all detached
  31                                          * processes. */
  32 } Detached;
  33
  34 static Detached *detList = NULL;        /* List of all detached proceses. */
  35 TCL_DECLARE_MUTEX(pipeMutex)            /* Guard access to detList. */
  36
  37 /*
  38  * Declarations for local procedures defined in this file:
  39  */
  40
  41 static TclFile  FileForRedirect _ANSI_ARGS_((Tcl_Interp *interp,
  42                     CONST char *spec, int atOk, CONST char *arg,
  43                     CONST char *nextArg, int flags, int *skipPtr,
  44                     int *closePtr, int *releasePtr));
  45 \f
  46 /*
  47  *----------------------------------------------------------------------
  48  *
  49  * FileForRedirect --
  50  *
  51  *      This procedure does much of the work of parsing redirection
  52  *      operators.  It handles "@" if specified and allowed, and a file
  53  *      name, and opens the file if necessary.
  54  *
  55  * Results:
  56  *      The return value is the descriptor number for the file.  If an
  57  *      error occurs then NULL is returned and an error message is left
  58  *      in the interp's result.  Several arguments are side-effected; see
  59  *      the argument list below for details.
  60  *
  61  * Side effects:
  62  *      None.
  63  *
  64  *----------------------------------------------------------------------
  65  */
  66
  67 static TclFile
  68 FileForRedirect(interp, spec, atOK, arg, nextArg, flags, skipPtr, closePtr,
  69         releasePtr)
  70     Tcl_Interp *interp;         /* Intepreter to use for error reporting. */
  71     CONST char *spec;                   /* Points to character just after
  72                                  * redirection character. */
  73     CONST char *arg;            /* Pointer to entire argument containing
  74                                  * spec:  used for error reporting. */
  75     int atOK;                   /* Non-zero means that '@' notation can be
  76                                  * used to specify a channel, zero means that
  77                                  * it isn't. */
  78     CONST char *nextArg;        /* Next argument in argc/argv array, if needed
  79                                  * for file name or channel name.  May be
  80                                  * NULL. */
  81     int flags;                  /* Flags to use for opening file or to
  82                                  * specify mode for channel. */
  83     int *skipPtr;               /* Filled with 1 if redirection target was
  84                                  * in spec, 2 if it was in nextArg. */
  85     int *closePtr;              /* Filled with one if the caller should
  86                                  * close the file when done with it, zero
  87                                  * otherwise. */
  88     int *releasePtr;
  89 {
  90     int writing = (flags & O_WRONLY);
  91     Tcl_Channel chan;
  92     TclFile file;
  93
  94     *skipPtr = 1;
  95     if ((atOK != 0)  && (*spec == '@')) {
  96         spec++;
  97         if (*spec == '\0') {
  98             spec = nextArg;
  99             if (spec == NULL) {
 100                 goto badLastArg;
 101             }
 102             *skipPtr = 2;
 103         }
 104         chan = Tcl_GetChannel(interp, spec, NULL);
 105         if (chan == (Tcl_Channel) NULL) {
 106             return NULL;
 107         }
 108         file = TclpMakeFile(chan, writing ? TCL_WRITABLE : TCL_READABLE);
 109         if (file == NULL) {
 110             Tcl_AppendResult(interp, "channel \"", Tcl_GetChannelName(chan),
 111                     "\" wasn't opened for ",
 112                     ((writing) ? "writing" : "reading"), (char *) NULL);
 113             return NULL;
 114         }
 115         *releasePtr = 1;
 116         if (writing) {
 117
 118             /*
 119              * Be sure to flush output to the file, so that anything
 120              * written by the child appears after stuff we've already
 121              * written.
 122              */
 123
 124             Tcl_Flush(chan);
 125         }
 126     } else {
 127         CONST char *name;
 128         Tcl_DString nameString;
 129
 130         if (*spec == '\0') {
 131             spec = nextArg;
 132             if (spec == NULL) {
 133                 goto badLastArg;
 134             }
 135             *skipPtr = 2;
 136         }
 137         name = Tcl_TranslateFileName(interp, spec, &nameString);
 138         if (name != NULL) {
 139             file = TclpOpenFile(name, flags);
 140         } else {
 141             file = NULL;
 142         }
 143         Tcl_DStringFree(&nameString);
 144         if (file == NULL) {
 145             Tcl_AppendResult(interp, "couldn't ",
 146                     ((writing) ? "write" : "read"), " file \"", spec, "\": ",
 147                     Tcl_PosixError(interp), (char *) NULL);
 148             return NULL;
 149         }
 150         *closePtr = 1;
 151     }
 152     return file;
 153
 154     badLastArg:
 155     Tcl_AppendResult(interp, "can't specify \"", arg,
 156             "\" as last word in command", (char *) NULL);
 157     return NULL;
 158 }
 159 \f
 160 /*
 161  *----------------------------------------------------------------------
 162  *
 163  * Tcl_DetachPids --
 164  *
 165  *      This procedure is called to indicate that one or more child
 166  *      processes have been placed in background and will never be
 167  *      waited for;  they should eventually be reaped by
 168  *      Tcl_ReapDetachedProcs.
 169  *
 170  * Results:
 171  *      None.
 172  *
 173  * Side effects:
 174  *      None.
 175  *
 176  *----------------------------------------------------------------------
 177  */
 178
 179 void
 180 Tcl_DetachPids(numPids, pidPtr)
 181     int numPids;                /* Number of pids to detach:  gives size
 182                                  * of array pointed to by pidPtr. */
 183     Tcl_Pid *pidPtr;            /* Array of pids to detach. */
 184 {
 185     register Detached *detPtr;
 186     int i;
 187
 188     Tcl_MutexLock(&pipeMutex);
 189     for (i = 0; i < numPids; i++) {
 190         detPtr = (Detached *) ckalloc(sizeof(Detached));
 191         detPtr->pid = pidPtr[i];
 192         detPtr->nextPtr = detList;
 193         detList = detPtr;
 194     }
 195     Tcl_MutexUnlock(&pipeMutex);
 196
 197 }
 198 \f
 199 /*
 200  *----------------------------------------------------------------------
 201  *
 202  * Tcl_ReapDetachedProcs --
 203  *
 204  *      This procedure checks to see if any detached processes have
 205  *      exited and, if so, it "reaps" them by officially waiting on
 206  *      them.  It should be called "occasionally" to make sure that
 207  *      all detached processes are eventually reaped.
 208  *
 209  * Results:
 210  *      None.
 211  *
 212  * Side effects:
 213  *      Processes are waited on, so that they can be reaped by the
 214  *      system.
 215  *
 216  *----------------------------------------------------------------------
 217  */
 218
 219 void
 220 Tcl_ReapDetachedProcs()
 221 {
 222     register Detached *detPtr;
 223     Detached *nextPtr, *prevPtr;
 224     int status;
 225     Tcl_Pid pid;
 226
 227     Tcl_MutexLock(&pipeMutex);
 228     for (detPtr = detList, prevPtr = NULL; detPtr != NULL; ) {
 229         pid = Tcl_WaitPid(detPtr->pid, &status, WNOHANG);
 230         if ((pid == 0) || ((pid == (Tcl_Pid) -1) && (errno != ECHILD))) {
 231             prevPtr = detPtr;
 232             detPtr = detPtr->nextPtr;
 233             continue;
 234         }
 235         nextPtr = detPtr->nextPtr;
 236         if (prevPtr == NULL) {
 237             detList = detPtr->nextPtr;
 238         } else {
 239             prevPtr->nextPtr = detPtr->nextPtr;
 240         }
 241         ckfree((char *) detPtr);
 242         detPtr = nextPtr;
 243     }
 244     Tcl_MutexUnlock(&pipeMutex);
 245 }
 246 \f
 247 /*
 248  *----------------------------------------------------------------------
 249  *
 250  * TclCleanupChildren --
 251  *
 252  *      This is a utility procedure used to wait for child processes
 253  *      to exit, record information about abnormal exits, and then
 254  *      collect any stderr output generated by them.
 255  *
 256  * Results:
 257  *      The return value is a standard Tcl result.  If anything at
 258  *      weird happened with the child processes, TCL_ERROR is returned
 259  *      and a message is left in the interp's result.
 260  *
 261  * Side effects:
 262  *      If the last character of the interp's result is a newline, then it
 263  *      is removed unless keepNewline is non-zero.  File errorId gets
 264  *      closed, and pidPtr is freed back to the storage allocator.
 265  *
 266  *----------------------------------------------------------------------
 267  */
 268
 269 int
 270 TclCleanupChildren(interp, numPids, pidPtr, errorChan)
 271     Tcl_Interp *interp;         /* Used for error messages. */
 272     int numPids;                /* Number of entries in pidPtr array. */
 273     Tcl_Pid *pidPtr;            /* Array of process ids of children. */
 274     Tcl_Channel errorChan;      /* Channel for file containing stderr output
 275                                  * from pipeline.  NULL means there isn't any
 276                                  * stderr output. */
 277 {
 278     int result = TCL_OK;
 279     int i, abnormalExit, anyErrorInfo;
 280     Tcl_Pid pid;
 281     WAIT_STATUS_TYPE waitStatus;
 282     CONST char *msg;
 283
 284     abnormalExit = 0;
 285     for (i = 0; i < numPids; i++) {
 286         pid = Tcl_WaitPid(pidPtr[i], (int *) &waitStatus, 0);
 287         if (pid == (Tcl_Pid) -1) {
 288             result = TCL_ERROR;
 289             if (interp != (Tcl_Interp *) NULL) {
 290                 msg = Tcl_PosixError(interp);
 291                 if (errno == ECHILD) {
 292                     /*
 293                      * This changeup in message suggested by Mark Diekhans
 294                      * to remind people that ECHILD errors can occur on
 295                      * some systems if SIGCHLD isn't in its default state.
 296                      */
 297
 298                     msg =
 299                         "child process lost (is SIGCHLD ignored or trapped?)";
 300                 }
 301                 Tcl_AppendResult(interp, "error waiting for process to exit: ",
 302                         msg, (char *) NULL);
 303             }
 304             continue;
 305         }
 306
 307         /*
 308          * Create error messages for unusual process exits.  An
 309          * extra newline gets appended to each error message, but
 310          * it gets removed below (in the same fashion that an
 311          * extra newline in the command's output is removed).
 312          */
 313
 314         if (!WIFEXITED(waitStatus) || (WEXITSTATUS(waitStatus) != 0)) {
 315             char msg1[TCL_INTEGER_SPACE], msg2[TCL_INTEGER_SPACE];
 316
 317             result = TCL_ERROR;
 318             TclFormatInt(msg1, (long) TclpGetPid(pid));
 319             if (WIFEXITED(waitStatus)) {
 320                 if (interp != (Tcl_Interp *) NULL) {
 321                     TclFormatInt(msg2, WEXITSTATUS(waitStatus));
 322                     Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2,
 323                             (char *) NULL);
 324                 }
 325                 abnormalExit = 1;
 326             } else if (WIFSIGNALED(waitStatus)) {
 327                 if (interp != (Tcl_Interp *) NULL) {
 328                     CONST char *p;
 329
 330                     p = Tcl_SignalMsg((int) (WTERMSIG(waitStatus)));
 331                     Tcl_SetErrorCode(interp, "CHILDKILLED", msg1,
 332                             Tcl_SignalId((int) (WTERMSIG(waitStatus))), p,
 333                             (char *) NULL);
 334                     Tcl_AppendResult(interp, "child killed: ", p, "\n",
 335                             (char *) NULL);
 336                 }
 337             } else if (WIFSTOPPED(waitStatus)) {
 338                 if (interp != (Tcl_Interp *) NULL) {
 339                     CONST char *p;
 340
 341                     p = Tcl_SignalMsg((int) (WSTOPSIG(waitStatus)));
 342                     Tcl_SetErrorCode(interp, "CHILDSUSP", msg1,
 343                             Tcl_SignalId((int) (WSTOPSIG(waitStatus))),
 344                             p, (char *) NULL);
 345                     Tcl_AppendResult(interp, "child suspended: ", p, "\n",
 346                             (char *) NULL);
 347                 }
 348             } else {
 349                 if (interp != (Tcl_Interp *) NULL) {
 350                     Tcl_AppendResult(interp,
 351                             "child wait status didn't make sense\n",
 352                             (char *) NULL);
 353                 }
 354             }
 355         }
 356     }
 357
 358     /*
 359      * Read the standard error file.  If there's anything there,
 360      * then return an error and add the file's contents to the result
 361      * string.
 362      */
 363
 364     anyErrorInfo = 0;
 365     if (errorChan != NULL) {
 366
 367         /*
 368          * Make sure we start at the beginning of the file.
 369          */
 370
 371         if (interp != NULL) {
 372             int count;
 373             Tcl_Obj *objPtr;
 374
 375             Tcl_Seek(errorChan, (Tcl_WideInt)0, SEEK_SET);
 376             objPtr = Tcl_NewObj();
 377             count = Tcl_ReadChars(errorChan, objPtr, -1, 0);
 378             if (count < 0) {
 379                 result = TCL_ERROR;
 380                 Tcl_DecrRefCount(objPtr);
 381                 Tcl_ResetResult(interp);
 382                 Tcl_AppendResult(interp, "error reading stderr output file: ",
 383                         Tcl_PosixError(interp), NULL);
 384             } else if (count > 0) {
 385                 anyErrorInfo = 1;
 386                 Tcl_SetObjResult(interp, objPtr);
 387                 result = TCL_ERROR;
 388             } else {
 389                 Tcl_DecrRefCount(objPtr);
 390             }
 391         }
 392         Tcl_Close(NULL, errorChan);
 393     }
 394
 395     /*
 396      * If a child exited abnormally but didn't output any error information
 397      * at all, generate an error message here.
 398      */
 399
 400     if ((abnormalExit != 0) && (anyErrorInfo == 0) && (interp != NULL)) {
 401         Tcl_AppendResult(interp, "child process exited abnormally",
 402                 (char *) NULL);
 403     }
 404     return result;
 405 }
 406 \f
 407 /*
 408  *----------------------------------------------------------------------
 409  *
 410  * TclCreatePipeline --
 411  *
 412  *      Given an argc/argv array, instantiate a pipeline of processes
 413  *      as described by the argv.
 414  *
 415  *      This procedure is unofficially exported for use by BLT.
 416  *
 417  * Results:
 418  *      The return value is a count of the number of new processes
 419  *      created, or -1 if an error occurred while creating the pipeline.
 420  *      *pidArrayPtr is filled in with the address of a dynamically
 421  *      allocated array giving the ids of all of the processes.  It
 422  *      is up to the caller to free this array when it isn't needed
 423  *      anymore.  If inPipePtr is non-NULL, *inPipePtr is filled in
 424  *      with the file id for the input pipe for the pipeline (if any):
 425  *      the caller must eventually close this file.  If outPipePtr
 426  *      isn't NULL, then *outPipePtr is filled in with the file id
 427  *      for the output pipe from the pipeline:  the caller must close
 428  *      this file.  If errFilePtr isn't NULL, then *errFilePtr is filled
 429  *      with a file id that may be used to read error output after the
 430  *      pipeline completes.
 431  *
 432  * Side effects:
 433  *      Processes and pipes are created.
 434  *
 435  *----------------------------------------------------------------------
 436  */
 437
 438 int
 439 TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
 440         outPipePtr, errFilePtr)
 441     Tcl_Interp *interp;         /* Interpreter to use for error reporting. */
 442     int argc;                   /* Number of entries in argv. */
 443     CONST char **argv;          /* Array of strings describing commands in
 444                                  * pipeline plus I/O redirection with <,
 445                                  * <<,  >, etc.  Argv[argc] must be NULL. */
 446     Tcl_Pid **pidArrayPtr;      /* Word at *pidArrayPtr gets filled in with
 447                                  * address of array of pids for processes
 448                                  * in pipeline (first pid is first process
 449                                  * in pipeline). */
 450     TclFile *inPipePtr;         /* If non-NULL, input to the pipeline comes
 451                                  * from a pipe (unless overridden by
 452                                  * redirection in the command).  The file
 453                                  * id with which to write to this pipe is
 454                                  * stored at *inPipePtr.  NULL means command
 455                                  * specified its own input source. */
 456     TclFile *outPipePtr;        /* If non-NULL, output to the pipeline goes
 457                                  * to a pipe, unless overriden by redirection
 458                                  * in the command.  The file id with which to
 459                                  * read frome this pipe is stored at
 460                                  * *outPipePtr.  NULL means command specified
 461                                  * its own output sink. */
 462     TclFile *errFilePtr;        /* If non-NULL, all stderr output from the
 463                                  * pipeline will go to a temporary file
 464                                  * created here, and a descriptor to read
 465                                  * the file will be left at *errFilePtr.
 466                                  * The file will be removed already, so
 467                                  * closing this descriptor will be the end
 468                                  * of the file.  If this is NULL, then
 469                                  * all stderr output goes to our stderr.
 470                                  * If the pipeline specifies redirection
 471                                  * then the file will still be created
 472                                  * but it will never get any data. */
 473 {
 474     Tcl_Pid *pidPtr = NULL;     /* Points to malloc-ed array holding all
 475                                  * the pids of child processes. */
 476     int numPids;                /* Actual number of processes that exist
 477                                  * at *pidPtr right now. */
 478     int cmdCount;               /* Count of number of distinct commands
 479                                  * found in argc/argv. */
 480     CONST char *inputLiteral = NULL;    /* If non-null, then this points to a
 481                                  * string containing input data (specified
 482                                  * via <<) to be piped to the first process
 483                                  * in the pipeline. */
 484     TclFile inputFile = NULL;   /* If != NULL, gives file to use as input for
 485                                  * first process in pipeline (specified via <
 486                                  * or <@). */
 487     int inputClose = 0;         /* If non-zero, then inputFile should be
 488                                  * closed when cleaning up. */
 489     int inputRelease = 0;
 490     TclFile outputFile = NULL;  /* Writable file for output from last command
 491                                  * in pipeline (could be file or pipe).  NULL
 492                                  * means use stdout. */
 493     int outputClose = 0;        /* If non-zero, then outputFile should be
 494                                  * closed when cleaning up. */
 495     int outputRelease = 0;
 496     TclFile errorFile = NULL;   /* Writable file for error output from all
 497                                  * commands in pipeline.  NULL means use
 498                                  * stderr. */
 499     int errorClose = 0;         /* If non-zero, then errorFile should be
 500                                  * closed when cleaning up. */
 501     int errorRelease = 0;
 502     CONST char *p;
 503     int skip, lastBar, lastArg, i, j, atOK, flags, errorToOutput;
 504     Tcl_DString execBuffer;
 505     TclFile pipeIn;
 506     TclFile curInFile, curOutFile, curErrFile;
 507     Tcl_Channel channel;
 508
 509     if (inPipePtr != NULL) {
 510         *inPipePtr = NULL;
 511     }
 512     if (outPipePtr != NULL) {
 513         *outPipePtr = NULL;
 514     }
 515     if (errFilePtr != NULL) {
 516         *errFilePtr = NULL;
 517     }
 518
 519     Tcl_DStringInit(&execBuffer);
 520
 521     pipeIn = NULL;
 522     curInFile = NULL;
 523     curOutFile = NULL;
 524     numPids = 0;
 525
 526     /*
 527      * First, scan through all the arguments to figure out the structure
 528      * of the pipeline.  Process all of the input and output redirection
 529      * arguments and remove them from the argument list in the pipeline.
 530      * Count the number of distinct processes (it's the number of "|"
 531      * arguments plus one) but don't remove the "|" arguments because
 532      * they'll be used in the second pass to seperate the individual
 533      * child processes.  Cannot start the child processes in this pass
 534      * because the redirection symbols may appear anywhere in the
 535      * command line -- e.g., the '<' that specifies the input to the
 536      * entire pipe may appear at the very end of the argument list.
 537      */
 538
 539     lastBar = -1;
 540     cmdCount = 1;
 541     for (i = 0; i < argc; i++) {
 542         skip = 0;
 543         p = argv[i];
 544         switch (*p++) {
 545         case '|':
 546             if (*p == '&') {
 547                 p++;
 548             }
 549             if (*p == '\0') {
 550                 if ((i == (lastBar + 1)) || (i == (argc - 1))) {
 551                     Tcl_SetResult(interp,
 552                             "illegal use of | or |& in command",
 553                             TCL_STATIC);
 554                     goto error;
 555                 }
 556             }
 557             lastBar = i;
 558             cmdCount++;
 559             break;
 560
 561         case '<':
 562             if (inputClose != 0) {
 563                 inputClose = 0;
 564                 TclpCloseFile(inputFile);
 565             }
 566             if (inputRelease != 0) {
 567                 inputRelease = 0;
 568                 TclpReleaseFile(inputFile);
 569             }
 570             if (*p == '<') {
 571                 inputFile = NULL;
 572                 inputLiteral = p + 1;
 573                 skip = 1;
 574                 if (*inputLiteral == '\0') {
 575                     inputLiteral = argv[i + 1];
 576                     if (inputLiteral == NULL) {
 577                         Tcl_AppendResult(interp, "can't specify \"", argv[i],
 578                                 "\" as last word in command", (char *) NULL);
 579                         goto error;
 580                     }
 581                     skip = 2;
 582                 }
 583             } else {
 584                 inputLiteral = NULL;
 585                 inputFile = FileForRedirect(interp, p, 1, argv[i],
 586                         argv[i + 1], O_RDONLY, &skip, &inputClose, &inputRelease);
 587                 if (inputFile == NULL) {
 588                     goto error;
 589                 }
 590             }
 591             break;
 592
 593         case '>':
 594             atOK = 1;
 595             flags = O_WRONLY | O_CREAT | O_TRUNC;
 596             errorToOutput = 0;
 597             if (*p == '>') {
 598                 p++;
 599                 atOK = 0;
 600                 flags = O_WRONLY | O_CREAT;
 601             }
 602             if (*p == '&') {
 603                 if (errorClose != 0) {
 604                     errorClose = 0;
 605                     TclpCloseFile(errorFile);
 606                 }
 607                 errorToOutput = 1;
 608                 p++;
 609             }
 610
 611             /*
 612              * Close the old output file, but only if the error file is
 613              * not also using it.
 614              */
 615
 616             if (outputClose != 0) {
 617                 outputClose = 0;
 618                 if (errorFile == outputFile) {
 619                     errorClose = 1;
 620                 } else {
 621                     TclpCloseFile(outputFile);
 622                 }
 623             }
 624             if (outputRelease != 0) {
 625                 outputRelease = 0;
 626                 if (errorFile == outputFile) {
 627                     errorRelease = 1;
 628                 } else {
 629                     TclpReleaseFile(outputFile);
 630                 }
 631             }
 632             outputFile = FileForRedirect(interp, p, atOK, argv[i],
 633                     argv[i + 1], flags, &skip, &outputClose, &outputRelease);
 634             if (outputFile == NULL) {
 635                 goto error;
 636             }
 637             if (errorToOutput) {
 638                 if (errorClose != 0) {
 639                     errorClose = 0;
 640                     TclpCloseFile(errorFile);
 641                 }
 642                 if (errorRelease != 0) {
 643                     errorRelease = 0;
 644                     TclpReleaseFile(errorFile);
 645                 }
 646                 errorFile = outputFile;
 647             }
 648             break;
 649
 650         case '2':
 651             if (*p != '>') {
 652                 break;
 653             }
 654             p++;
 655             atOK = 1;
 656             flags = O_WRONLY | O_CREAT | O_TRUNC;
 657             if (*p == '>') {
 658                 p++;
 659                 atOK = 0;
 660                 flags = O_WRONLY | O_CREAT;
 661             }
 662             if (errorClose != 0) {
 663                 errorClose = 0;
 664                 TclpCloseFile(errorFile);
 665             }
 666             if (errorRelease != 0) {
 667                 errorRelease = 0;
 668                 TclpReleaseFile(errorFile);
 669             }
 670             errorFile = FileForRedirect(interp, p, atOK, argv[i],
 671                     argv[i + 1], flags, &skip, &errorClose, &errorRelease);
 672             if (errorFile == NULL) {
 673                 goto error;
 674             }
 675             break;
 676         }
 677
 678         if (skip != 0) {
 679             for (j = i + skip; j < argc; j++) {
 680                 argv[j - skip] = argv[j];
 681             }
 682             argc -= skip;
 683             i -= 1;
 684         }
 685     }
 686
 687     if (inputFile == NULL) {
 688         if (inputLiteral != NULL) {
 689             /*
 690              * The input for the first process is immediate data coming from
 691              * Tcl.  Create a temporary file for it and put the data into the
 692              * file.
 693              */
 694             inputFile = TclpCreateTempFile(inputLiteral);
 695             if (inputFile == NULL) {
 696                 Tcl_AppendResult(interp,
 697                         "couldn't create input file for command: ",
 698                         Tcl_PosixError(interp), (char *) NULL);
 699                 goto error;
 700             }
 701             inputClose = 1;
 702         } else if (inPipePtr != NULL) {
 703             /*
 704              * The input for the first process in the pipeline is to
 705              * come from a pipe that can be written from by the caller.
 706              */
 707
 708             if (TclpCreatePipe(&inputFile, inPipePtr) == 0) {
 709                 Tcl_AppendResult(interp,
 710                         "couldn't create input pipe for command: ",
 711                         Tcl_PosixError(interp), (char *) NULL);
 712                 goto error;
 713             }
 714             inputClose = 1;
 715         } else {
 716             /*
 717              * The input for the first process comes from stdin.
 718              */
 719
 720             channel = Tcl_GetStdChannel(TCL_STDIN);
 721             if (channel != NULL) {
 722                 inputFile = TclpMakeFile(channel, TCL_READABLE);
 723                 if (inputFile != NULL) {
 724                     inputRelease = 1;
 725                 }
 726             }
 727         }
 728     }
 729
 730     if (outputFile == NULL) {
 731         if (outPipePtr != NULL) {
 732             /*
 733              * Output from the last process in the pipeline is to go to a
 734              * pipe that can be read by the caller.
 735              */
 736
 737             if (TclpCreatePipe(outPipePtr, &outputFile) == 0) {
 738                 Tcl_AppendResult(interp,
 739                         "couldn't create output pipe for command: ",
 740                         Tcl_PosixError(interp), (char *) NULL);
 741                 goto error;
 742             }
 743             outputClose = 1;
 744         } else {
 745             /*
 746              * The output for the last process goes to stdout.
 747              */
 748
 749             channel = Tcl_GetStdChannel(TCL_STDOUT);
 750             if (channel) {
 751                 outputFile = TclpMakeFile(channel, TCL_WRITABLE);
 752                 if (outputFile != NULL) {
 753                     outputRelease = 1;
 754                 }
 755             }
 756         }
 757     }
 758
 759     if (errorFile == NULL) {
 760         if (errFilePtr != NULL) {
 761             /*
 762              * Set up the standard error output sink for the pipeline, if
 763              * requested.  Use a temporary file which is opened, then deleted.
 764              * Could potentially just use pipe, but if it filled up it could
 765              * cause the pipeline to deadlock:  we'd be waiting for processes
 766              * to complete before reading stderr, and processes couldn't
 767              * complete because stderr was backed up.
 768              */
 769
 770             errorFile = TclpCreateTempFile(NULL);
 771             if (errorFile == NULL) {
 772                 Tcl_AppendResult(interp,
 773                         "couldn't create error file for command: ",
 774                         Tcl_PosixError(interp), (char *) NULL);
 775                 goto error;
 776             }
 777             *errFilePtr = errorFile;
 778         } else {
 779             /*
 780              * Errors from the pipeline go to stderr.
 781              */
 782
 783             channel = Tcl_GetStdChannel(TCL_STDERR);
 784             if (channel) {
 785                 errorFile = TclpMakeFile(channel, TCL_WRITABLE);
 786                 if (errorFile != NULL) {
 787                     errorRelease = 1;
 788                 }
 789             }
 790         }
 791     }
 792
 793     /*
 794      * Scan through the argc array, creating a process for each
 795      * group of arguments between the "|" characters.
 796      */
 797
 798     Tcl_ReapDetachedProcs();
 799     pidPtr = (Tcl_Pid *) ckalloc((unsigned) (cmdCount * sizeof(Tcl_Pid)));
 800
 801     curInFile = inputFile;
 802
 803     for (i = 0; i < argc; i = lastArg + 1) {
 804         int result, joinThisError;
 805         Tcl_Pid pid;
 806         CONST char *oldName;
 807
 808         /*
 809          * Convert the program name into native form.
 810          */
 811
 812         if (Tcl_TranslateFileName(interp, argv[i], &execBuffer) == NULL) {
 813             goto error;
 814         }
 815
 816         /*
 817          * Find the end of the current segment of the pipeline.
 818          */
 819
 820         joinThisError = 0;
 821         for (lastArg = i; lastArg < argc; lastArg++) {
 822             if (argv[lastArg][0] == '|') {
 823                 if (argv[lastArg][1] == '\0') {
 824                     break;
 825                 }
 826                 if ((argv[lastArg][1] == '&') && (argv[lastArg][2] == '\0')) {
 827                     joinThisError = 1;
 828                     break;
 829                 }
 830             }
 831         }
 832         argv[lastArg] = NULL;
 833
 834         /*
 835          * If this is the last segment, use the specified outputFile.
 836          * Otherwise create an intermediate pipe.  pipeIn will become the
 837          * curInFile for the next segment of the pipe.
 838          */
 839
 840         if (lastArg == argc) {
 841             curOutFile = outputFile;
 842         } else {
 843             if (TclpCreatePipe(&pipeIn, &curOutFile) == 0) {
 844                 Tcl_AppendResult(interp, "couldn't create pipe: ",
 845                         Tcl_PosixError(interp), (char *) NULL);
 846                 goto error;
 847             }
 848         }
 849
 850         if (joinThisError != 0) {
 851             curErrFile = curOutFile;
 852         } else {
 853             curErrFile = errorFile;
 854         }
 855
 856         /*
 857          * Restore argv[i], since a caller wouldn't expect the contents of
 858          * argv to be modified.
 859          */
 860
 861         oldName = argv[i];
 862         argv[i] = Tcl_DStringValue(&execBuffer);
 863         result = TclpCreateProcess(interp, lastArg - i, argv + i,
 864                 curInFile, curOutFile, curErrFile, &pid);
 865         argv[i] = oldName;
 866         if (result != TCL_OK) {
 867             goto error;
 868         }
 869         Tcl_DStringFree(&execBuffer);
 870
 871         pidPtr[numPids] = pid;
 872         numPids++;
 873
 874         /*
 875          * Close off our copies of file descriptors that were set up for
 876          * this child, then set up the input for the next child.
 877          */
 878
 879         if ((curInFile != NULL) && (curInFile != inputFile)) {
 880             TclpCloseFile(curInFile);
 881         }
 882         curInFile = pipeIn;
 883         pipeIn = NULL;
 884
 885         if ((curOutFile != NULL) && (curOutFile != outputFile)) {
 886             TclpCloseFile(curOutFile);
 887         }
 888         curOutFile = NULL;
 889     }
 890
 891     *pidArrayPtr = pidPtr;
 892
 893     /*
 894      * All done.  Cleanup open files lying around and then return.
 895      */
 896
 897 cleanup:
 898     Tcl_DStringFree(&execBuffer);
 899
 900     if (inputClose) {
 901         TclpCloseFile(inputFile);
 902     } else if (inputRelease) {
 903         TclpReleaseFile(inputFile);
 904     }
 905     if (outputClose) {
 906         TclpCloseFile(outputFile);
 907     } else if (outputRelease) {
 908         TclpReleaseFile(outputFile);
 909     }
 910     if (errorClose) {
 911         TclpCloseFile(errorFile);
 912     } else if (errorRelease) {
 913         TclpReleaseFile(errorFile);
 914     }
 915     return numPids;
 916
 917     /*
 918      * An error occurred.  There could have been extra files open, such
 919      * as pipes between children.  Clean them all up.  Detach any child
 920      * processes that have been created.
 921      */
 922
 923 error:
 924     if (pipeIn != NULL) {
 925         TclpCloseFile(pipeIn);
 926     }
 927     if ((curOutFile != NULL) && (curOutFile != outputFile)) {
 928         TclpCloseFile(curOutFile);
 929     }
 930     if ((curInFile != NULL) && (curInFile != inputFile)) {
 931         TclpCloseFile(curInFile);
 932     }
 933     if ((inPipePtr != NULL) && (*inPipePtr != NULL)) {
 934         TclpCloseFile(*inPipePtr);
 935         *inPipePtr = NULL;
 936     }
 937     if ((outPipePtr != NULL) && (*outPipePtr != NULL)) {
 938         TclpCloseFile(*outPipePtr);
 939         *outPipePtr = NULL;
 940     }
 941     if ((errFilePtr != NULL) && (*errFilePtr != NULL)) {
 942         TclpCloseFile(*errFilePtr);
 943         *errFilePtr = NULL;
 944     }
 945     if (pidPtr != NULL) {
 946         for (i = 0; i < numPids; i++) {
 947             if (pidPtr[i] != (Tcl_Pid) -1) {
 948                 Tcl_DetachPids(1, &pidPtr[i]);
 949             }
 950         }
 951         ckfree((char *) pidPtr);
 952     }
 953     numPids = -1;
 954     goto cleanup;
 955 }
 956 \f
 957 /*
 958  *----------------------------------------------------------------------
 959  *
 960  * Tcl_OpenCommandChannel --
 961  *
 962  *      Opens an I/O channel to one or more subprocesses specified
 963  *      by argc and argv.  The flags argument determines the
 964  *      disposition of the stdio handles.  If the TCL_STDIN flag is
 965  *      set then the standard input for the first subprocess will
 966  *      be tied to the channel:  writing to the channel will provide
 967  *      input to the subprocess.  If TCL_STDIN is not set, then
 968  *      standard input for the first subprocess will be the same as
 969  *      this application's standard input.  If TCL_STDOUT is set then
 970  *      standard output from the last subprocess can be read from the
 971  *      channel;  otherwise it goes to this application's standard
 972  *      output.  If TCL_STDERR is set, standard error output for all
 973  *      subprocesses is returned to the channel and results in an error
 974  *      when the channel is closed;  otherwise it goes to this
 975  *      application's standard error.  If TCL_ENFORCE_MODE is not set,
 976  *      then argc and argv can redirect the stdio handles to override
 977  *      TCL_STDIN, TCL_STDOUT, and TCL_STDERR;  if it is set, then it
 978  *      is an error for argc and argv to override stdio channels for
 979  *      which TCL_STDIN, TCL_STDOUT, and TCL_STDERR have been set.
 980  *
 981  * Results:
 982  *      A new command channel, or NULL on failure with an error
 983  *      message left in interp.
 984  *
 985  * Side effects:
 986  *      Creates processes, opens pipes.
 987  *
 988  *----------------------------------------------------------------------
 989  */
 990
 991 Tcl_Channel
 992 Tcl_OpenCommandChannel(interp, argc, argv, flags)
 993     Tcl_Interp *interp;         /* Interpreter for error reporting. Can
 994                                  * NOT be NULL. */
 995     int argc;                   /* How many arguments. */
 996     CONST char **argv;          /* Array of arguments for command pipe. */
 997     int flags;                  /* Or'ed combination of TCL_STDIN, TCL_STDOUT,
 998                                  * TCL_STDERR, and TCL_ENFORCE_MODE. */
 999 {
1000     TclFile *inPipePtr, *outPipePtr, *errFilePtr;
1001     TclFile inPipe, outPipe, errFile;
1002     int numPids;
1003     Tcl_Pid *pidPtr;
1004     Tcl_Channel channel;
1005
1006     inPipe = outPipe = errFile = NULL;
1007
1008     inPipePtr = (flags & TCL_STDIN) ? &inPipe : NULL;
1009     outPipePtr = (flags & TCL_STDOUT) ? &outPipe : NULL;
1010     errFilePtr = (flags & TCL_STDERR) ? &errFile : NULL;
1011
1012     numPids = TclCreatePipeline(interp, argc, argv, &pidPtr, inPipePtr,
1013             outPipePtr, errFilePtr);
1014
1015     if (numPids < 0) {
1016         goto error;
1017     }
1018
1019     /*
1020      * Verify that the pipes that were created satisfy the
1021      * readable/writable constraints.
1022      */
1023
1024     if (flags & TCL_ENFORCE_MODE) {
1025         if ((flags & TCL_STDOUT) && (outPipe == NULL)) {
1026             Tcl_AppendResult(interp, "can't read output from command:",
1027                     " standard output was redirected", (char *) NULL);
1028             goto error;
1029         }
1030         if ((flags & TCL_STDIN) && (inPipe == NULL)) {
1031             Tcl_AppendResult(interp, "can't write input to command:",
1032                     " standard input was redirected", (char *) NULL);
1033             goto error;
1034         }
1035     }
1036
1037     channel = TclpCreateCommandChannel(outPipe, inPipe, errFile,
1038             numPids, pidPtr);
1039
1040     if (channel == (Tcl_Channel) NULL) {
1041         Tcl_AppendResult(interp, "pipe for command could not be created",
1042                 (char *) NULL);
1043         goto error;
1044     }
1045     return channel;
1046
1047 error:
1048     if (numPids > 0) {
1049         Tcl_DetachPids(numPids, pidPtr);
1050         ckfree((char *) pidPtr);
1051     }
1052     if (inPipe != NULL) {
1053         TclpCloseFile(inPipe);
1054     }
1055     if (outPipe != NULL) {
1056         TclpCloseFile(outPipe);
1057     }
1058     if (errFile != NULL) {
1059         TclpCloseFile(errFile);
1060     }
1061     return NULL;
1062 }