util/src/TclTk/tcl8.6.12/generic/tclPipe.c

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