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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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