home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tkisrc04.zip / tcl / os2 / tclIOUtil.c < prev    next >
C/C++ Source or Header  |  1998-08-07  |  38KB  |  1,288 lines
  1. /* 
  2.  * tclIOUtil.c --
  3.  *
  4.  *    This file contains a collection of utility procedures that
  5.  *    are shared by the platform specific IO drivers.
  6.  *
  7.  *    Parts of this file are based on code contributed by Karl
  8.  *    Lehenbauer, Mark Diekhans and Peter da Silva.
  9.  *
  10.  * Copyright (c) 1991-1994 The Regents of the University of California.
  11.  * Copyright (c) 1994-1996 Sun Microsystems, Inc.
  12.  *
  13.  * See the file "license.terms" for information on usage and redistribution
  14.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  15.  *
  16.  * SCCS: @(#) tclIOUtil.c 1.122 96/04/02 18:46:40
  17.  */
  18.  
  19. #include "tclInt.h"
  20. #include "tclPort.h"
  21.  
  22. /*
  23.  * A linked list of the following structures is used to keep track
  24.  * of child processes that have been detached but haven't exited
  25.  * yet, so we can make sure that they're properly "reaped" (officially
  26.  * waited for) and don't lie around as zombies cluttering the
  27.  * system.
  28.  */
  29.  
  30. typedef struct Detached {
  31.     int pid;                /* Id of process that's been detached
  32.                      * but isn't known to have exited. */
  33.     struct Detached *nextPtr;        /* Next in list of all detached
  34.                      * processes. */
  35. } Detached;
  36.  
  37. static Detached *detList = NULL;    /* List of all detached proceses. */
  38.  
  39. /*
  40.  * Declarations for local procedures defined in this file:
  41.  */
  42.  
  43. static Tcl_File    FileForRedirect _ANSI_ARGS_((Tcl_Interp *interp,
  44.                         char *spec, int atOk, char *arg, int flags,
  45.                         char *nextArg, int *skipPtr, int *closePtr));
  46.  
  47. /*
  48.  *----------------------------------------------------------------------
  49.  *
  50.  * FileForRedirect --
  51.  *
  52.  *    This procedure does much of the work of parsing redirection
  53.  *    operators.  It handles "@" if specified and allowed, and a file
  54.  *    name, and opens the file if necessary.
  55.  *
  56.  * Results:
  57.  *    The return value is the descriptor number for the file.  If an
  58.  *    error occurs then NULL is returned and an error message is left
  59.  *    in interp->result.  Several arguments are side-effected; see
  60.  *    the argument list below for details.
  61.  *
  62.  * Side effects:
  63.  *    None.
  64.  *
  65.  *----------------------------------------------------------------------
  66.  */
  67.  
  68. static Tcl_File
  69. FileForRedirect(interp, spec, atOk, arg, flags, nextArg, skipPtr, closePtr)
  70.     Tcl_Interp *interp;            /* Intepreter to use for error
  71.                      * reporting. */
  72.     register char *spec;            /* Points to character just after
  73.                      * redirection character. */
  74.     int atOk;                /* Non-zero means '@' notation is
  75.                      * OK, zero means it isn't. */
  76.     char *arg;                /* Pointer to entire argument
  77.                      * containing spec:  used for error
  78.                      * reporting. */
  79.     int flags;                /* Flags to use for opening file. */
  80.     char *nextArg;            /* Next argument in argc/argv
  81.                      * array, if needed for file name.
  82.                      * May be NULL. */
  83.     int *skipPtr;            /* This value is incremented if
  84.                      * nextArg is used for redirection
  85.                      * spec. */
  86.     int *closePtr;            /* This value is set to 1 if the file
  87.                      * that's returned must be closed, 0
  88.                      * if it was specified with "@" so
  89.                      * it must be left open. */
  90. {
  91.     int writing = (flags & O_WRONLY);
  92.     Tcl_Channel chan;
  93.     Tcl_File file;
  94.  
  95.     if (atOk && (*spec == '@')) {
  96.     spec++;
  97.     if (*spec == 0) {
  98.         spec = nextArg;
  99.         if (spec == NULL) {
  100.         goto badLastArg;
  101.         }
  102.         *skipPtr += 1;
  103.     }
  104.         chan = Tcl_GetChannel(interp, spec, NULL);
  105.         if (chan == (Tcl_Channel) NULL) {
  106.             return NULL;
  107.         }
  108.     *closePtr = 0;
  109.         file = Tcl_GetChannelFile(chan, writing ? TCL_WRITABLE : TCL_READABLE);
  110.         if (file == NULL) {
  111.             Tcl_AppendResult(interp,
  112.                     "channel \"",
  113.                     Tcl_GetChannelName(chan),
  114.                     "\" wasn't opened for ",
  115.                     writing ? "writing" : "reading", (char *) NULL);
  116.             return NULL;
  117.         }
  118.     if (writing) {
  119.  
  120.         /*
  121.          * Be sure to flush output to the file, so that anything
  122.          * written by the child appears after stuff we've already
  123.          * written.
  124.          */
  125.  
  126.             Tcl_Flush(chan);
  127.     }
  128.     } else {
  129.     Tcl_DString buffer;
  130.     char *name;
  131.  
  132.     if (*spec == 0) {
  133.         spec = nextArg;
  134.         if (spec == NULL) {
  135.         goto badLastArg;
  136.         }
  137.         *skipPtr += 1;
  138.     }
  139.     name = Tcl_TranslateFileName(interp, spec, &buffer);
  140.     if (name) {
  141.         file = TclOpenFile(name, flags);
  142.     } else {
  143.         file = NULL;
  144.     }
  145.     Tcl_DStringFree(&buffer);
  146.     if (file == NULL) {
  147.         Tcl_AppendResult(interp, "couldn't ",
  148.             (writing) ? "write" : "read", " file \"", spec, "\": ",
  149.             Tcl_PosixError(interp), (char *) NULL);
  150.         return NULL;
  151.     }
  152.     *closePtr = 1;
  153.     }
  154.     return file;
  155.  
  156.     badLastArg:
  157.     Tcl_AppendResult(interp, "can't specify \"", arg,
  158.         "\" as last word in command", (char *) NULL);
  159.     return NULL;
  160. }
  161.  
  162. /*
  163.  *----------------------------------------------------------------------
  164.  *
  165.  * TclGetOpenMode --
  166.  *
  167.  * Description:
  168.  *    Computes a POSIX mode mask for opening a file, from a given string,
  169.  *    and also sets a flag to indicate whether the caller should seek to
  170.  *    EOF after opening the file.
  171.  *
  172.  * Results:
  173.  *    On success, returns mode to pass to "open". If an error occurs, the
  174.  *    returns -1 and if interp is not NULL, sets interp->result to an
  175.  *    error message.
  176.  *
  177.  * Side effects:
  178.  *    Sets the integer referenced by seekFlagPtr to 1 to tell the caller
  179.  *    to seek to EOF after opening the file.
  180.  *
  181.  * Special note:
  182.  *    This code is based on a prototype implementation contributed
  183.  *    by Mark Diekhans.
  184.  *
  185.  *----------------------------------------------------------------------
  186.  */
  187.  
  188. int
  189. TclGetOpenMode(interp, string, seekFlagPtr)
  190.     Tcl_Interp *interp;            /* Interpreter to use for error
  191.                      * reporting - may be NULL. */
  192.     char *string;            /* Mode string, e.g. "r+" or
  193.                      * "RDONLY CREAT". */
  194.     int *seekFlagPtr;            /* Set this to 1 if the caller
  195.                                          * should seek to EOF during the
  196.                                          * opening of the file. */
  197. {
  198.     int mode, modeArgc, c, i, gotRW;
  199.     char **modeArgv, *flag;
  200. #define RW_MODES (O_RDONLY|O_WRONLY|O_RDWR)
  201.  
  202.     /*
  203.      * Check for the simpler fopen-like access modes (e.g. "r").  They
  204.      * are distinguished from the POSIX access modes by the presence
  205.      * of a lower-case first letter.
  206.      */
  207.  
  208.     *seekFlagPtr = 0;
  209.     mode = 0;
  210.     if (islower(UCHAR(string[0]))) {
  211.     switch (string[0]) {
  212.         case 'r':
  213.         mode = O_RDONLY;
  214.         break;
  215.         case 'w':
  216.         mode = O_WRONLY|O_CREAT|O_TRUNC;
  217.         break;
  218.         case 'a':
  219.         mode = O_WRONLY|O_CREAT;
  220.                 *seekFlagPtr = 1;
  221.         break;
  222.         default:
  223.         error:
  224.                 if (interp != (Tcl_Interp *) NULL) {
  225.                     Tcl_AppendResult(interp,
  226.                             "illegal access mode \"", string, "\"",
  227.                             (char *) NULL);
  228.                 }
  229.         return -1;
  230.     }
  231.     if (string[1] == '+') {
  232.         mode &= ~(O_RDONLY|O_WRONLY);
  233.         mode |= O_RDWR;
  234.         if (string[2] != 0) {
  235.         goto error;
  236.         }
  237.     } else if (string[1] != 0) {
  238.         goto error;
  239.     }
  240.         return mode;
  241.     }
  242.  
  243.     /*
  244.      * The access modes are specified using a list of POSIX modes
  245.      * such as O_CREAT.
  246.      *
  247.      * IMPORTANT NOTE: We rely on Tcl_SplitList working correctly when
  248.      * a NULL interpreter is passed in.
  249.      */
  250.  
  251.     if (Tcl_SplitList(interp, string, &modeArgc, &modeArgv) != TCL_OK) {
  252.         if (interp != (Tcl_Interp *) NULL) {
  253.             Tcl_AddErrorInfo(interp,
  254.                     "\n    while processing open access modes \"");
  255.             Tcl_AddErrorInfo(interp, string);
  256.             Tcl_AddErrorInfo(interp, "\"");
  257.         }
  258.         return -1;
  259.     }
  260.     
  261.     gotRW = 0;
  262.     for (i = 0; i < modeArgc; i++) {
  263.     flag = modeArgv[i];
  264.     c = flag[0];
  265.     if ((c == 'R') && (strcmp(flag, "RDONLY") == 0)) {
  266.         mode = (mode & ~RW_MODES) | O_RDONLY;
  267.         gotRW = 1;
  268.     } else if ((c == 'W') && (strcmp(flag, "WRONLY") == 0)) {
  269.         mode = (mode & ~RW_MODES) | O_WRONLY;
  270.         gotRW = 1;
  271.     } else if ((c == 'R') && (strcmp(flag, "RDWR") == 0)) {
  272.         mode = (mode & ~RW_MODES) | O_RDWR;
  273.         gotRW = 1;
  274.     } else if ((c == 'A') && (strcmp(flag, "APPEND") == 0)) {
  275.         mode |= O_APPEND;
  276.             *seekFlagPtr = 1;
  277.     } else if ((c == 'C') && (strcmp(flag, "CREAT") == 0)) {
  278.         mode |= O_CREAT;
  279.     } else if ((c == 'E') && (strcmp(flag, "EXCL") == 0)) {
  280.         mode |= O_EXCL;
  281.     } else if ((c == 'N') && (strcmp(flag, "NOCTTY") == 0)) {
  282. #ifdef O_NOCTTY
  283.         mode |= O_NOCTTY;
  284. #else
  285.         if (interp != (Tcl_Interp *) NULL) {
  286.                 Tcl_AppendResult(interp, "access mode \"", flag,
  287.                         "\" not supported by this system", (char *) NULL);
  288.             }
  289.             ckfree((char *) modeArgv);
  290.         return -1;
  291. #endif
  292.     } else if ((c == 'N') && (strcmp(flag, "NONBLOCK") == 0)) {
  293. #if defined(O_NDELAY) || defined(O_NONBLOCK)
  294. #   ifdef O_NONBLOCK
  295.         mode |= O_NONBLOCK;
  296. #   else
  297.         mode |= O_NDELAY;
  298. #   endif
  299. #else
  300.             if (interp != (Tcl_Interp *) NULL) {
  301.                 Tcl_AppendResult(interp, "access mode \"", flag,
  302.                         "\" not supported by this system", (char *) NULL);
  303.             }
  304.             ckfree((char *) modeArgv);
  305.         return -1;
  306. #endif
  307.     } else if ((c == 'T') && (strcmp(flag, "TRUNC") == 0)) {
  308.         mode |= O_TRUNC;
  309.     } else {
  310.             if (interp != (Tcl_Interp *) NULL) {
  311.                 Tcl_AppendResult(interp, "invalid access mode \"", flag,
  312.                         "\": must be RDONLY, WRONLY, RDWR, APPEND, CREAT",
  313.                         " EXCL, NOCTTY, NONBLOCK, or TRUNC", (char *) NULL);
  314.             }
  315.         ckfree((char *) modeArgv);
  316.         return -1;
  317.     }
  318.     }
  319.     ckfree((char *) modeArgv);
  320.     if (!gotRW) {
  321.         if (interp != (Tcl_Interp *) NULL) {
  322.             Tcl_AppendResult(interp, "access mode must include either",
  323.                     " RDONLY, WRONLY, or RDWR", (char *) NULL);
  324.         }
  325.     return -1;
  326.     }
  327.     return mode;
  328. }
  329.  
  330. /*
  331.  *----------------------------------------------------------------------
  332.  *
  333.  * Tcl_EvalFile --
  334.  *
  335.  *    Read in a file and process the entire file as one gigantic
  336.  *    Tcl command.
  337.  *
  338.  * Results:
  339.  *    A standard Tcl result, which is either the result of executing
  340.  *    the file or an error indicating why the file couldn't be read.
  341.  *
  342.  * Side effects:
  343.  *    Depends on the commands in the file.
  344.  *
  345.  *----------------------------------------------------------------------
  346.  */
  347.  
  348. int
  349. Tcl_EvalFile(interp, fileName)
  350.     Tcl_Interp *interp;        /* Interpreter in which to process file. */
  351.     char *fileName;        /* Name of file to process.  Tilde-substitution
  352.                  * will be performed on this name. */
  353. {
  354.     int result;
  355.     struct stat statBuf;
  356.     char *cmdBuffer = (char *) NULL;
  357.     char *oldScriptFile = (char *) NULL;
  358.     Interp *iPtr = (Interp *) interp;
  359.     Tcl_DString buffer;
  360.     char *nativeName = (char *) NULL;
  361.     Tcl_Channel chan = (Tcl_Channel) NULL;
  362.  
  363.     Tcl_ResetResult(interp);
  364.     oldScriptFile = iPtr->scriptFile;
  365.     iPtr->scriptFile = fileName;
  366.     Tcl_DStringInit(&buffer);
  367.     nativeName = Tcl_TranslateFileName(interp, fileName, &buffer);
  368.     if (nativeName == NULL) {
  369.     goto error;
  370.     }
  371.  
  372.     /*
  373.      * If Tcl_TranslateFileName didn't already copy the file name, do it
  374.      * here.  This way we don't depend on fileName staying constant
  375.      * throughout the execution of the script (e.g., what if it happens
  376.      * to point to a Tcl variable that the script could change?).
  377.      */
  378.  
  379.     if (nativeName != Tcl_DStringValue(&buffer)) {
  380.     Tcl_DStringSetLength(&buffer, 0);
  381.     Tcl_DStringAppend(&buffer, nativeName, -1);
  382.     nativeName = Tcl_DStringValue(&buffer);
  383.     }
  384.     if (stat(nativeName, &statBuf) == -1) {
  385.         Tcl_SetErrno(errno);
  386.     Tcl_AppendResult(interp, "couldn't read file \"", fileName,
  387.         "\": ", Tcl_PosixError(interp), (char *) NULL);
  388.     goto error;
  389.     }
  390.     chan = Tcl_OpenFileChannel(interp, nativeName, "r", 0644);
  391.     if (chan == (Tcl_Channel) NULL) {
  392.         Tcl_ResetResult(interp);
  393.     Tcl_AppendResult(interp, "couldn't read file \"", fileName,
  394.         "\": ", Tcl_PosixError(interp), (char *) NULL);
  395.     goto error;
  396.     }
  397.     cmdBuffer = (char *) ckalloc((unsigned) statBuf.st_size+1);
  398.     result = Tcl_Read(chan, cmdBuffer, statBuf.st_size);
  399.     if (result < 0) {
  400.         Tcl_Close(interp, chan);
  401.     Tcl_AppendResult(interp, "couldn't read file \"", fileName,
  402.         "\": ", Tcl_PosixError(interp), (char *) NULL);
  403.     goto error;
  404.     }
  405.     cmdBuffer[result] = 0;
  406.     if (Tcl_Close(interp, chan) != TCL_OK) {
  407.         goto error;
  408.     }
  409.  
  410.     result = Tcl_Eval(interp, cmdBuffer);
  411.     if (result == TCL_RETURN) {
  412.     result = TclUpdateReturnInfo(iPtr);
  413.     } else if (result == TCL_ERROR) {
  414.     char msg[200];
  415.  
  416.     /*
  417.      * Record information telling where the error occurred.
  418.      */
  419.  
  420.     sprintf(msg, "\n    (file \"%.150s\" line %d)", fileName,
  421.         interp->errorLine);
  422.     Tcl_AddErrorInfo(interp, msg);
  423.     }
  424.     iPtr->scriptFile = oldScriptFile;
  425.     ckfree(cmdBuffer);
  426.     Tcl_DStringFree(&buffer);
  427.     return result;
  428.  
  429. error:
  430.     if (cmdBuffer != (char *) NULL) {
  431.         ckfree(cmdBuffer);
  432.     }
  433.     iPtr->scriptFile = oldScriptFile;
  434.     Tcl_DStringFree(&buffer);
  435.     return TCL_ERROR;
  436. }
  437.  
  438. /*
  439.  *----------------------------------------------------------------------
  440.  *
  441.  * Tcl_DetachPids --
  442.  *
  443.  *    This procedure is called to indicate that one or more child
  444.  *    processes have been placed in background and will never be
  445.  *    waited for;  they should eventually be reaped by
  446.  *    Tcl_ReapDetachedProcs.
  447.  *
  448.  * Results:
  449.  *    None.
  450.  *
  451.  * Side effects:
  452.  *    None.
  453.  *
  454.  *----------------------------------------------------------------------
  455.  */
  456.  
  457. void
  458. Tcl_DetachPids(numPids, pidPtr)
  459.     int numPids;        /* Number of pids to detach:  gives size
  460.                  * of array pointed to by pidPtr. */
  461.     int *pidPtr;        /* Array of pids to detach. */
  462. {
  463.     register Detached *detPtr;
  464.     int i;
  465.  
  466.     for (i = 0; i < numPids; i++) {
  467.     detPtr = (Detached *) ckalloc(sizeof(Detached));
  468.     detPtr->pid = pidPtr[i];
  469.     detPtr->nextPtr = detList;
  470.     detList = detPtr;
  471.     }
  472. }
  473.  
  474. /*
  475.  *----------------------------------------------------------------------
  476.  *
  477.  * Tcl_ReapDetachedProcs --
  478.  *
  479.  *    This procedure checks to see if any detached processes have
  480.  *    exited and, if so, it "reaps" them by officially waiting on
  481.  *    them.  It should be called "occasionally" to make sure that
  482.  *    all detached processes are eventually reaped.
  483.  *
  484.  * Results:
  485.  *    None.
  486.  *
  487.  * Side effects:
  488.  *    Processes are waited on, so that they can be reaped by the
  489.  *    system.
  490.  *
  491.  *----------------------------------------------------------------------
  492.  */
  493.  
  494. void
  495. Tcl_ReapDetachedProcs()
  496. {
  497.     register Detached *detPtr;
  498.     Detached *nextPtr, *prevPtr;
  499.     int status;
  500.     pid_t pid;
  501.  
  502.     for (detPtr = detList, prevPtr = NULL; detPtr != NULL; ) {
  503.     pid = Tcl_WaitPid(detPtr->pid, &status, WNOHANG);
  504.     if ((pid == 0) || ((pid == -1) && (errno != ECHILD))) {
  505.         prevPtr = detPtr;
  506.         detPtr = detPtr->nextPtr;
  507.         continue;
  508.     }
  509.     nextPtr = detPtr->nextPtr;
  510.     if (prevPtr == NULL) {
  511.         detList = detPtr->nextPtr;
  512.     } else {
  513.         prevPtr->nextPtr = detPtr->nextPtr;
  514.     }
  515.     ckfree((char *) detPtr);
  516.     detPtr = nextPtr;
  517.     }
  518. }
  519.  
  520. /*
  521.  *----------------------------------------------------------------------
  522.  *
  523.  * TclCleanupChildren --
  524.  *
  525.  *    This is a utility procedure used to wait for child processes
  526.  *    to exit, record information about abnormal exits, and then
  527.  *    collect any stderr output generated by them.
  528.  *
  529.  * Results:
  530.  *    The return value is a standard Tcl result.  If anything at
  531.  *    weird happened with the child processes, TCL_ERROR is returned
  532.  *    and a message is left in interp->result.
  533.  *
  534.  * Side effects:
  535.  *    If the last character of interp->result is a newline, then it
  536.  *    is removed unless keepNewline is non-zero.  File errorId gets
  537.  *    closed, and pidPtr is freed back to the storage allocator.
  538.  *
  539.  *----------------------------------------------------------------------
  540.  */
  541.  
  542. int
  543. TclCleanupChildren(interp, numPids, pidPtr, errorChan)
  544.     Tcl_Interp *interp;        /* Used for error messages. */
  545.     int numPids;        /* Number of entries in pidPtr array. */
  546.     int *pidPtr;        /* Array of process ids of children. */
  547.     Tcl_Channel errorChan;    /* Channel for file containing stderr output
  548.                  * from pipeline.  NULL means there isn't any
  549.                  * stderr output. */
  550. {
  551.     int result = TCL_OK;
  552.     int i, pid, abnormalExit, anyErrorInfo;
  553.     WAIT_STATUS_TYPE waitStatus;
  554.     char *msg;
  555.  
  556.     abnormalExit = 0;
  557.     for (i = 0; i < numPids; i++) {
  558.         pid = (int) Tcl_WaitPid(pidPtr[i], (int *) &waitStatus, 0);
  559.     if (pid == -1) {
  560.         result = TCL_ERROR;
  561.             if (interp != (Tcl_Interp *) NULL) {
  562.                 msg = Tcl_PosixError(interp);
  563.                 if (errno == ECHILD) {
  564.             /*
  565.                      * This changeup in message suggested by Mark Diekhans
  566.                      * to remind people that ECHILD errors can occur on
  567.                      * some systems if SIGCHLD isn't in its default state.
  568.                      */
  569.  
  570.                     msg =
  571.                         "child process lost (is SIGCHLD ignored or trapped?)";
  572.                 }
  573.                 Tcl_AppendResult(interp, "error waiting for process to exit: ",
  574.                         msg, (char *) NULL);
  575.             }
  576.         continue;
  577.     }
  578.  
  579.     /*
  580.      * Create error messages for unusual process exits.  An
  581.      * extra newline gets appended to each error message, but
  582.      * it gets removed below (in the same fashion that an
  583.      * extra newline in the command's output is removed).
  584.      */
  585.  
  586.     if (!WIFEXITED(waitStatus) || (WEXITSTATUS(waitStatus) != 0)) {
  587.         char msg1[20], msg2[20];
  588.  
  589.         result = TCL_ERROR;
  590.         sprintf(msg1, "%d", pid);
  591.         if (WIFEXITED(waitStatus)) {
  592.                 if (interp != (Tcl_Interp *) NULL) {
  593.                     sprintf(msg2, "%d", WEXITSTATUS(waitStatus));
  594.                     Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2,
  595.                             (char *) NULL);
  596.                 }
  597.         abnormalExit = 1;
  598.         } else if (WIFSIGNALED(waitStatus)) {
  599.                 if (interp != (Tcl_Interp *) NULL) {
  600.                     char *p;
  601.                     
  602.                     p = Tcl_SignalMsg((int) (WTERMSIG(waitStatus)));
  603.                     Tcl_SetErrorCode(interp, "CHILDKILLED", msg1,
  604.                             Tcl_SignalId((int) (WTERMSIG(waitStatus))), p,
  605.                             (char *) NULL);
  606.                     Tcl_AppendResult(interp, "child killed: ", p, "\n",
  607.                             (char *) NULL);
  608.                 }
  609.         } else if (WIFSTOPPED(waitStatus)) {
  610.                 if (interp != (Tcl_Interp *) NULL) {
  611.                     char *p;
  612.  
  613.                     p = Tcl_SignalMsg((int) (WSTOPSIG(waitStatus)));
  614.                     Tcl_SetErrorCode(interp, "CHILDSUSP", msg1,
  615.                             Tcl_SignalId((int) (WSTOPSIG(waitStatus))),
  616.                             p, (char *) NULL);
  617.                     Tcl_AppendResult(interp, "child suspended: ", p, "\n",
  618.                             (char *) NULL);
  619.                 }
  620.         } else {
  621.                 if (interp != (Tcl_Interp *) NULL) {
  622.                     Tcl_AppendResult(interp,
  623.                             "child wait status didn't make sense\n",
  624.                             (char *) NULL);
  625.                 }
  626.         }
  627.     }
  628.     }
  629.  
  630.     /*
  631.      * Read the standard error file.  If there's anything there,
  632.      * then return an error and add the file's contents to the result
  633.      * string.
  634.      */
  635.  
  636.     anyErrorInfo = 0;
  637.     if (errorChan != NULL) {
  638.  
  639.     /*
  640.      * Make sure we start at the beginning of the file.
  641.      */
  642.  
  643.     Tcl_Seek(errorChan, 0L, SEEK_SET);
  644.  
  645.         if (interp != (Tcl_Interp *) NULL) {
  646.             while (1) {
  647. #define BUFFER_SIZE 1000
  648.                 char buffer[BUFFER_SIZE+1];
  649.                 int count;
  650.     
  651.                 count = Tcl_Read(errorChan, buffer, BUFFER_SIZE);
  652.                 if (count == 0) {
  653.                     break;
  654.                 }
  655.                 result = TCL_ERROR;
  656.                 if (count < 0) {
  657.                     Tcl_AppendResult(interp,
  658.                             "error reading stderr output file: ",
  659.                             Tcl_PosixError(interp), (char *) NULL);
  660.                     break;    /* out of the "while (1)" loop. */
  661.                 }
  662.                 buffer[count] = 0;
  663.                 Tcl_AppendResult(interp, buffer, (char *) NULL);
  664.                 anyErrorInfo = 1;
  665.             }
  666.         }
  667.         
  668.     Tcl_Close(NULL, errorChan);
  669.     }
  670.  
  671.     /*
  672.      * If a child exited abnormally but didn't output any error information
  673.      * at all, generate an error message here.
  674.      */
  675.  
  676.     if (abnormalExit && !anyErrorInfo && (interp != (Tcl_Interp *) NULL)) {
  677.     Tcl_AppendResult(interp, "child process exited abnormally",
  678.         (char *) NULL);
  679.     }
  680.     
  681.     return result;
  682. }
  683.  
  684. /*
  685.  *----------------------------------------------------------------------
  686.  *
  687.  * TclCreatePipeline --
  688.  *
  689.  *    Given an argc/argv array, instantiate a pipeline of processes
  690.  *    as described by the argv.
  691.  *
  692.  * Results:
  693.  *    The return value is a count of the number of new processes
  694.  *    created, or -1 if an error occurred while creating the pipeline.
  695.  *    *pidArrayPtr is filled in with the address of a dynamically
  696.  *    allocated array giving the ids of all of the processes.  It
  697.  *    is up to the caller to free this array when it isn't needed
  698.  *    anymore.  If inPipePtr is non-NULL, *inPipePtr is filled in
  699.  *    with the file id for the input pipe for the pipeline (if any):
  700.  *    the caller must eventually close this file.  If outPipePtr
  701.  *    isn't NULL, then *outPipePtr is filled in with the file id
  702.  *    for the output pipe from the pipeline:  the caller must close
  703.  *    this file.  If errFilePtr isn't NULL, then *errFilePtr is filled
  704.  *    with a file id that may be used to read error output after the
  705.  *    pipeline completes.
  706.  *
  707.  * Side effects:
  708.  *    Processes and pipes are created.
  709.  *
  710.  *----------------------------------------------------------------------
  711.  */
  712.  
  713. int
  714. TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
  715.     outPipePtr, errFilePtr)
  716.     Tcl_Interp *interp;        /* Interpreter to use for error reporting. */
  717.     int argc;            /* Number of entries in argv. */
  718.     char **argv;        /* Array of strings describing commands in
  719.                  * pipeline plus I/O redirection with <,
  720.                  * <<,  >, etc.  Argv[argc] must be NULL. */
  721.     int **pidArrayPtr;        /* Word at *pidArrayPtr gets filled in with
  722.                  * address of array of pids for processes
  723.                  * in pipeline (first pid is first process
  724.                  * in pipeline). */
  725.     Tcl_File *inPipePtr;    /* If non-NULL, input to the pipeline comes
  726.                  * from a pipe (unless overridden by
  727.                  * redirection in the command).  The file
  728.                  * id with which to write to this pipe is
  729.                  * stored at *inPipePtr.  NULL means command
  730.                  * specified its own input source. */
  731.     Tcl_File *outPipePtr;    /* If non-NULL, output to the pipeline goes
  732.                  * to a pipe, unless overriden by redirection
  733.                  * in the command.  The file id with which to
  734.                  * read frome this pipe is stored at
  735.                  * *outPipePtr.  NULL means command specified
  736.                  * its own output sink. */
  737.     Tcl_File *errFilePtr;    /* If non-NULL, all stderr output from the
  738.                  * pipeline will go to a temporary file
  739.                  * created here, and a descriptor to read
  740.                  * the file will be left at *errFilePtr.
  741.                  * The file will be removed already, so
  742.                  * closing this descriptor will be the end
  743.                  * of the file.  If this is NULL, then
  744.                  * all stderr output goes to our stderr.
  745.                  * If the pipeline specifies redirection
  746.                  * then the file will still be created
  747.                  * but it will never get any data. */
  748. {
  749. #if defined( MAC_TCL )
  750.     Tcl_AppendResult(interp,
  751.         "command pipelines not supported on Macintosh OS", NULL);
  752.     return -1;
  753. #else /* !MAC_TCL */
  754.     int *pidPtr = NULL;        /* Points to malloc-ed array holding all
  755.                  * the pids of child processes. */
  756.     int numPids = 0;        /* Actual number of processes that exist
  757.                  * at *pidPtr right now. */
  758.     int cmdCount;        /* Count of number of distinct commands
  759.                  * found in argc/argv. */
  760.     char *input = NULL;        /* If non-null, then this points to a
  761.                  * string containing input data (specified
  762.                  * via <<) to be piped to the first process
  763.                  * in the pipeline. */
  764.     Tcl_File inputFile = NULL;
  765.                 /* If != NULL, gives file to use as input for
  766.                  * first process in pipeline (specified via <
  767.                  * or <@). */
  768.     int closeInput = 0;        /* If non-zero, then must close inputId
  769.                  * when cleaning up (zero means the file needs
  770.                  * to stay open for some other reason). */
  771.     Tcl_File outputFile = NULL;
  772.                 /* Writable file for output from last command
  773.                  * in pipeline (could be file or pipe).  NULL
  774.                  * means use stdout. */
  775.     int closeOutput = 0;    /* Non-zero means must close outputId when
  776.                  * cleaning up (similar to closeInput). */
  777.     Tcl_File errorFile = NULL;
  778.                 /* Writable file for error output from all
  779.                  * commands in pipeline.  NULL means use
  780.                  * stderr. */
  781.     int closeError = 0;        /* Non-zero means must close errorId when
  782.                  * cleaning up. */
  783.     int skip;            /* Number of arguments to skip (because they
  784.                  * specify redirection). */
  785.     int lastBar;
  786.     int i, j;
  787.     char *p;
  788.     int hasPipes = TclHasPipes();
  789.     char finalOut[L_tmpnam];
  790.     char intIn[L_tmpnam];
  791.  
  792.     finalOut[0]  = '\0';
  793.     intIn[0] = '\0';
  794.     
  795.     if (inPipePtr != NULL) {
  796.     *inPipePtr = NULL;
  797.     }
  798.     if (outPipePtr != NULL) {
  799.     *outPipePtr = NULL;
  800.     }
  801.     if (errFilePtr != NULL) {
  802.     *errFilePtr = NULL;
  803.     }
  804.  
  805.     /*
  806.      * First, scan through all the arguments to figure out the structure
  807.      * of the pipeline.  Process all of the input and output redirection
  808.      * arguments and remove them from the argument list in the pipeline.
  809.      * Count the number of distinct processes (it's the number of "|"
  810.      * arguments plus one) but don't remove the "|" arguments.
  811.      */
  812.  
  813.     cmdCount = 1;
  814.     lastBar = -1;
  815.     for (i = 0; i < argc; i++) {
  816.     if ((argv[i][0] == '|') && (((argv[i][1] == 0))
  817.         || ((argv[i][1] == '&') && (argv[i][2] == 0)))) {
  818.         if ((i == (lastBar+1)) || (i == (argc-1))) {
  819.         interp->result = "illegal use of | or |& in command";
  820.         return -1;
  821.         }
  822.         lastBar = i;
  823.         cmdCount++;
  824.         continue;
  825.     } else if (argv[i][0] == '<') {
  826.         if ((inputFile != NULL) && closeInput) {
  827.         TclCloseFile(inputFile);
  828.         }
  829.         inputFile = NULL;
  830.         skip = 1;
  831.         if (argv[i][1] == '<') {
  832.         input = argv[i]+2;
  833.         if (*input == 0) {
  834.             input = argv[i+1];
  835.             if (input == 0) {
  836.             Tcl_AppendResult(interp, "can't specify \"", argv[i],
  837.                 "\" as last word in command", (char *) NULL);
  838.             goto error;
  839.             }
  840.             skip = 2;
  841.         }
  842.         } else {
  843.         input = 0;
  844.         inputFile = FileForRedirect(interp, argv[i]+1, 1, argv[i],
  845.             O_RDONLY, argv[i+1], &skip, &closeInput);
  846.         if (inputFile == NULL) {
  847.             goto error;
  848.         }
  849.  
  850.         /* When Win32s dies out, this code can be removed */
  851.         if (!hasPipes) {
  852.             if (!closeInput) {
  853.             Tcl_AppendResult(interp, "redirection with '@'",
  854.                 " notation is not supported on this system",
  855.                 (char *) NULL);
  856.             goto error;
  857.             }
  858.             strcpy(intIn, skip == 1 ? argv[i]+1 : argv[i+1]);
  859.         }
  860.         }
  861.     } else if (argv[i][0] == '>') {
  862.         int append, useForStdErr, useForStdOut, mustClose, atOk, flags;
  863.         Tcl_File file;
  864.  
  865.         skip = atOk = 1;
  866.         append = useForStdErr = 0;
  867.         useForStdOut = 1;
  868.         if (argv[i][1] == '>') {
  869.         p = argv[i] + 2;
  870.         append = 1;
  871.         atOk = 0;
  872.         flags = O_WRONLY|O_CREAT;
  873.         } else {
  874.         p = argv[i] + 1;
  875.         flags = O_WRONLY|O_CREAT|O_TRUNC;
  876.         }
  877.         if (*p == '&') {
  878.         useForStdErr = 1;
  879.         p++;
  880.         }
  881.         file = FileForRedirect(interp, p, atOk, argv[i], flags, argv[i+1],
  882.             &skip, &mustClose);
  883.         if (file == NULL) {
  884.         goto error;
  885.         }
  886.  
  887.         /* When Win32s dies out, this code can be removed */
  888.         if (!hasPipes) {
  889.         if (!mustClose) {
  890.             Tcl_AppendResult(interp, "redirection with '@'",
  891.                 " notation is not supported on this system",
  892.                 (char *) NULL);
  893.             goto error;
  894.         }
  895.         strcpy(finalOut, skip == 1 ? p : argv[i+1]);
  896.         }
  897.  
  898.         if (hasPipes && append) {
  899.         TclSeekFile(file, 0L, 2);
  900.         }
  901.  
  902.         /*
  903.          * Got the file descriptor.  Now use it for standard output,
  904.          * standard error, or both, depending on the redirection.
  905.          */
  906.  
  907.         if (useForStdOut) {
  908.         if ((outputFile != NULL) && closeOutput) {
  909.             TclCloseFile(outputFile);
  910.         }
  911.         outputFile = file;
  912.         closeOutput = mustClose;
  913.         }
  914.         if (useForStdErr) {
  915.         if ((errorFile != NULL) && closeError) {
  916.             TclCloseFile(errorFile);
  917.         }
  918.         errorFile = file;
  919.         closeError = (useForStdOut) ? 0 : mustClose;
  920.         }
  921.     } else if ((argv[i][0] == '2') && (argv[i][1] == '>')) {
  922.         int append, atOk, flags;
  923.  
  924.         if ((errorFile != NULL) && closeError) {
  925.         TclCloseFile(errorFile);
  926.         }
  927.         skip = 1;
  928.         p = argv[i] + 2;
  929.         if (*p == '>') {
  930.         p++;
  931.         append = 1;
  932.         atOk = 0;
  933.         flags = O_WRONLY|O_CREAT;
  934.         } else {
  935.         append = 0;
  936.         atOk = 1;
  937.         flags = O_WRONLY|O_CREAT|O_TRUNC;
  938.         }
  939.         errorFile = FileForRedirect(interp, p, atOk, argv[i], flags,
  940.             argv[i+1], &skip, &closeError);
  941.         if (errorFile == NULL) {
  942.         goto error;
  943.         }
  944.         if (hasPipes && append) {
  945.         TclSeekFile(errorFile, 0L, 2);
  946.         }
  947.     } else {
  948.         continue;
  949.     }
  950.     for (j = i+skip; j < argc; j++) {
  951.         argv[j-skip] = argv[j];
  952.     }
  953.     argc -= skip;
  954.     i -= 1;            /* Process next arg from same position. */
  955.     }
  956.     if (argc == 0) {
  957.     interp->result =  "didn't specify command to execute";
  958.     return -1;
  959.     }
  960.  
  961.     if ((hasPipes && inputFile == NULL) || (!hasPipes && intIn[0] == '\0')) {
  962.     if (input != NULL) {
  963.  
  964.         /*
  965.          * The input for the first process is immediate data coming from
  966.          * Tcl.  Create a temporary file for it and put the data into the
  967.          * file.
  968.          */
  969.         
  970.         inputFile = TclCreateTempFile(input);
  971.         closeInput = 1;
  972.         if (inputFile == NULL) {
  973.         Tcl_AppendResult(interp,
  974.             "couldn't create input file for command: ",
  975.             Tcl_PosixError(interp), (char *) NULL);
  976.         goto error;
  977.         }
  978.     } else if (inPipePtr != NULL) {
  979.         Tcl_File inPipe, outPipe;
  980.         /*
  981.          * The input for the first process in the pipeline is to
  982.          * come from a pipe that can be written from this end.
  983.          */
  984.  
  985.         if (!hasPipes || TclCreatePipe(&inPipe, &outPipe) == 0) {
  986.         Tcl_AppendResult(interp,
  987.             "couldn't create input pipe for command: ",
  988.             Tcl_PosixError(interp), (char *) NULL);
  989.         goto error;
  990.         }
  991.         inputFile = inPipe;
  992.         closeInput = 1;
  993.         *inPipePtr = outPipe;
  994.     }
  995.     }
  996.  
  997.     /*
  998.      * Set up a pipe to receive output from the pipeline, if no other
  999.      * output sink has been specified.
  1000.      */
  1001.  
  1002.     if ((outputFile == NULL) && (outPipePtr != NULL)) {
  1003.     if (!hasPipes) {
  1004.         tmpnam(finalOut);
  1005.     } else {
  1006.         Tcl_File inPipe, outPipe;
  1007.         if (TclCreatePipe(&inPipe, &outPipe) == 0) {
  1008.         Tcl_AppendResult(interp,
  1009.             "couldn't create output pipe for command: ",
  1010.             Tcl_PosixError(interp), (char *) NULL);
  1011.         goto error;
  1012.         }
  1013.         outputFile = outPipe;
  1014.         closeOutput = 1;
  1015.         *outPipePtr = inPipe;
  1016.     }
  1017.     }
  1018.  
  1019.     /*
  1020.      * Set up the standard error output sink for the pipeline, if
  1021.      * requested.  Use a temporary file which is opened, then deleted.
  1022.      * Could potentially just use pipe, but if it filled up it could
  1023.      * cause the pipeline to deadlock:  we'd be waiting for processes
  1024.      * to complete before reading stderr, and processes couldn't complete
  1025.      * because stderr was backed up.
  1026.      */
  1027.  
  1028.     if (errFilePtr && !errorFile) {
  1029.     *errFilePtr = TclCreateTempFile(NULL);
  1030.     if (*errFilePtr == NULL) {
  1031.         Tcl_AppendResult(interp,
  1032.             "couldn't create error file for command: ",
  1033.             Tcl_PosixError(interp), (char *) NULL);
  1034.         goto error;
  1035.     }
  1036.     errorFile = *errFilePtr;
  1037.     closeError = 0;
  1038.     }
  1039.     
  1040.     /*
  1041.      * Scan through the argc array, forking off a process for each
  1042.      * group of arguments between "|" arguments.
  1043.      */
  1044.  
  1045.     pidPtr = (int *) ckalloc((unsigned) (cmdCount * sizeof(int)));
  1046.     Tcl_ReapDetachedProcs();
  1047.  
  1048.     if (TclSpawnPipeline(interp, pidPtr, &numPids, argc, argv, 
  1049.         inputFile, outputFile, errorFile, intIn, finalOut) == 0) {
  1050.     goto error;
  1051.     }
  1052.     *pidArrayPtr = pidPtr;
  1053.  
  1054.     /*
  1055.      * All done.  Cleanup open files lying around and then return.
  1056.      */
  1057.  
  1058. cleanup:
  1059.     if ((inputFile != NULL) && closeInput) {
  1060.     TclCloseFile(inputFile);
  1061.     }
  1062.     if ((outputFile != NULL) && closeOutput) {
  1063.     TclCloseFile(outputFile);
  1064.     }
  1065.     if ((errorFile != NULL) && closeError) {
  1066.     TclCloseFile(errorFile);
  1067.     }
  1068.     return numPids;
  1069.  
  1070.     /*
  1071.      * An error occurred.  There could have been extra files open, such
  1072.      * as pipes between children.  Clean them all up.  Detach any child
  1073.      * processes that have been created.
  1074.      */
  1075.  
  1076. error:
  1077.     if ((inPipePtr != NULL) && (*inPipePtr != NULL)) {
  1078.     TclCloseFile(*inPipePtr);
  1079.     *inPipePtr = NULL;
  1080.     }
  1081.     if ((outPipePtr != NULL) && (*outPipePtr != NULL)) {
  1082.     TclCloseFile(*outPipePtr);
  1083.     *outPipePtr = NULL;
  1084.     }
  1085.     if ((errFilePtr != NULL) && (*errFilePtr != NULL)) {
  1086.     TclCloseFile(*errFilePtr);
  1087.     *errFilePtr = NULL;
  1088.     }
  1089.     if (pidPtr != NULL) {
  1090.     for (i = 0; i < numPids; i++) {
  1091.         if (pidPtr[i] != -1) {
  1092.         Tcl_DetachPids(1, &pidPtr[i]);
  1093.         }
  1094.     }
  1095.     ckfree((char *) pidPtr);
  1096.     }
  1097.     numPids = -1;
  1098.     goto cleanup;
  1099. #endif /* !MAC_TCL */
  1100. }
  1101.  
  1102. /*
  1103.  *----------------------------------------------------------------------
  1104.  *
  1105.  * Tcl_GetErrno --
  1106.  *
  1107.  *    Gets the current value of the Tcl error code variable. This is
  1108.  *    currently the global variable "errno" but could in the future
  1109.  *    change to something else.
  1110.  *
  1111.  * Results:
  1112.  *    The value of the Tcl error code variable.
  1113.  *
  1114.  * Side effects:
  1115.  *    None. Note that the value of the Tcl error code variable is
  1116.  *    UNDEFINED if a call to Tcl_SetErrno did not precede this call.
  1117.  *
  1118.  *----------------------------------------------------------------------
  1119.  */
  1120.  
  1121. int
  1122. Tcl_GetErrno()
  1123. {
  1124.     return errno;
  1125. }
  1126.  
  1127. /*
  1128.  *----------------------------------------------------------------------
  1129.  *
  1130.  * Tcl_SetErrno --
  1131.  *
  1132.  *    Sets the Tcl error code variable to the supplied value.
  1133.  *
  1134.  * Results:
  1135.  *    None.
  1136.  *
  1137.  * Side effects:
  1138.  *    Modifies the value of the Tcl error code variable.
  1139.  *
  1140.  *----------------------------------------------------------------------
  1141.  */
  1142.  
  1143. void
  1144. Tcl_SetErrno(err)
  1145.     int err;            /* The new value. */
  1146. {
  1147.     errno = err;
  1148. }
  1149.  
  1150. /*
  1151.  *----------------------------------------------------------------------
  1152.  *
  1153.  * Tcl_PosixError --
  1154.  *
  1155.  *    This procedure is typically called after UNIX kernel calls
  1156.  *    return errors.  It stores machine-readable information about
  1157.  *    the error in $errorCode returns an information string for
  1158.  *    the caller's use.
  1159.  *
  1160.  * Results:
  1161.  *    The return value is a human-readable string describing the
  1162.  *    error.
  1163.  *
  1164.  * Side effects:
  1165.  *    The global variable $errorCode is reset.
  1166.  *
  1167.  *----------------------------------------------------------------------
  1168.  */
  1169.  
  1170. char *
  1171. Tcl_PosixError(interp)
  1172.     Tcl_Interp *interp;        /* Interpreter whose $errorCode variable
  1173.                  * is to be changed. */
  1174. {
  1175.     char *id, *msg;
  1176.  
  1177.     msg = Tcl_ErrnoMsg(errno);
  1178.     id = Tcl_ErrnoId();
  1179.     Tcl_SetErrorCode(interp, "POSIX", id, msg, (char *) NULL);
  1180.     return msg;
  1181. }
  1182.  
  1183. /*
  1184.  *----------------------------------------------------------------------
  1185.  *
  1186.  * Tcl_OpenCommandChannel --
  1187.  *
  1188.  *    Opens an I/O channel to one or more subprocesses specified
  1189.  *    by argc and argv.  The flags argument determines the
  1190.  *    disposition of the stdio handles.  If the TCL_STDIN flag is
  1191.  *    set then the standard input for the first subprocess will
  1192.  *    be tied to the channel:  writing to the channel will provide
  1193.  *    input to the subprocess.  If TCL_STDIN is not set, then
  1194.  *    standard input for the first subprocess will be the same as
  1195.  *    this application's standard input.  If TCL_STDOUT is set then
  1196.  *    standard output from the last subprocess can be read from the
  1197.  *    channel;  otherwise it goes to this application's standard
  1198.  *    output.  If TCL_STDERR is set, standard error output for all
  1199.  *    subprocesses is returned to the channel and results in an error
  1200.  *    when the channel is closed;  otherwise it goes to this
  1201.  *    application's standard error.  If TCL_ENFORCE_MODE is not set,
  1202.  *    then argc and argv can redirect the stdio handles to override
  1203.  *    TCL_STDIN, TCL_STDOUT, and TCL_STDERR;  if it is set, then it 
  1204.  *    is an error for argc and argv to override stdio channels for
  1205.  *    which TCL_STDIN, TCL_STDOUT, and TCL_STDERR have been set.
  1206.  *
  1207.  * Results:
  1208.  *    A new command channel, or NULL on failure with an error
  1209.  *    message left in interp.
  1210.  *
  1211.  * Side effects:
  1212.  *    Creates processes, opens pipes.
  1213.  *
  1214.  *----------------------------------------------------------------------
  1215.  */
  1216.  
  1217. Tcl_Channel
  1218. Tcl_OpenCommandChannel(interp, argc, argv, flags)
  1219.     Tcl_Interp *interp;        /* Interpreter for error reporting. Can
  1220.                                  * NOT be NULL. */
  1221.     int argc;            /* How many arguments. */
  1222.     char **argv;        /* Array of arguments for command pipe. */
  1223.     int flags;            /* Or'ed combination of TCL_STDIN, TCL_STDOUT,
  1224.                  * TCL_STDERR, and TCL_ENFORCE_MODE. */
  1225. {
  1226.     Tcl_File *inPipePtr, *outPipePtr, *errFilePtr;
  1227.     Tcl_File inPipe, outPipe, errFile;
  1228.     int numPids, *pidPtr;
  1229.     Tcl_Channel channel;
  1230.  
  1231.     inPipe = outPipe = errFile = NULL;
  1232.  
  1233.     inPipePtr = (flags & TCL_STDIN) ? &inPipe : NULL;
  1234.     outPipePtr = (flags & TCL_STDOUT) ? &outPipe : NULL;
  1235.     errFilePtr = (flags & TCL_STDERR) ? &errFile : NULL;
  1236.     
  1237.     numPids = TclCreatePipeline(interp, argc, argv, &pidPtr, inPipePtr,
  1238.             outPipePtr, errFilePtr);
  1239.  
  1240.     if (numPids < 0) {
  1241.     goto error;
  1242.     }
  1243.  
  1244.     /*
  1245.      * Verify that the pipes that were created satisfy the
  1246.      * readable/writable constraints. 
  1247.      */
  1248.  
  1249.     if (flags & TCL_ENFORCE_MODE) {
  1250.     if ((flags & TCL_STDOUT) && (outPipe == NULL)) {
  1251.         Tcl_AppendResult(interp, "can't read output from command:",
  1252.             " standard output was redirected", (char *) NULL);
  1253.         goto error;
  1254.     }
  1255.     if ((flags & TCL_STDIN) && (inPipe == NULL)) {
  1256.         Tcl_AppendResult(interp, "can't write input to command:",
  1257.             " standard input was redirected", (char *) NULL);
  1258.         goto error;
  1259.     }
  1260.     }
  1261.     
  1262.     channel = TclCreateCommandChannel(outPipe, inPipe, errFile,
  1263.         numPids, pidPtr);
  1264.  
  1265.     if (channel == (Tcl_Channel) NULL) {
  1266.         Tcl_AppendResult(interp, "pipe for command could not be created",
  1267.                 (char *) NULL);
  1268.     goto error;
  1269.     }
  1270.     return channel;
  1271.  
  1272. error:
  1273.     if (numPids > 0) {
  1274.     Tcl_DetachPids(numPids, pidPtr);
  1275.     ckfree((char *) pidPtr);
  1276.     }
  1277.     if (inPipe != NULL) {
  1278.     TclClosePipeFile(inPipe);
  1279.     }
  1280.     if (outPipe != NULL) {
  1281.     TclClosePipeFile(outPipe);
  1282.     }
  1283.     if (errFile != NULL) {
  1284.     TclClosePipeFile(errFile);
  1285.     }
  1286.     return NULL;
  1287. }
  1288.