home *** CD-ROM | disk | FTP | other *** search
/ Stone Design / Stone Design.iso / Stone_Friends / Wave / WavesWorld / Source / Libraries / tcl7.4b3 / tclUnixUtil.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-01-06  |  38.1 KB  |  1,444 lines
  1. /* 
  2.  * tclUnixUtil.c --
  3.  *
  4.  *    This file contains a collection of utility procedures that
  5.  *    are present in the Tcl's UNIX core but not in the generic
  6.  *    core.  For example, they do file manipulation and process
  7.  *    manipulation.
  8.  *
  9.  *    Parts of this file are based on code contributed by Karl
  10.  *    Lehenbauer, Mark Diekhans and Peter da Silva.
  11.  *
  12.  * Copyright (c) 1991-1994 The Regents of the University of California.
  13.  * Copyright (c) 1994 Sun Microsystems, Inc.
  14.  *
  15.  * See the file "license.terms" for information on usage and redistribution
  16.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  17.  */
  18.  
  19. #ifndef lint
  20. static char sccsid[] = "@(#) tclUnixUtil.c 1.54 95/01/06 08:28:03";
  21. #endif /* not lint */
  22.  
  23. #include "tclInt.h"
  24. #include "tclPort.h"
  25.  
  26. /*
  27.  * A linked list of the following structures is used to keep track
  28.  * of child processes that have been detached but haven't exited
  29.  * yet, so we can make sure that they're properly "reaped" (officially
  30.  * waited for) and don't lie around as zombies cluttering the
  31.  * system.
  32.  */
  33.  
  34. typedef struct Detached {
  35.     int pid;                /* Id of process that's been detached
  36.                      * but isn't known to have exited. */
  37.     struct Detached *nextPtr;        /* Next in list of all detached
  38.                      * processes. */
  39. } Detached;
  40.  
  41. static Detached *detList = NULL;    /* List of all detached proceses. */
  42.  
  43. /*
  44.  * The following variables are used to keep track of all the open files
  45.  * in the process.  These files can be shared across interpreters, so the
  46.  * information can't be put in the Interp structure.
  47.  */
  48.  
  49. int tclNumFiles = 0;        /* Number of entries in tclOpenFiles below.
  50.                  * 0 means array hasn't been created yet. */
  51. OpenFile **tclOpenFiles;    /* Pointer to malloc-ed array of pointers
  52.                  * to information about open files.  Entry
  53.                  * N corresponds to the file with fileno N.
  54.                  * If an entry is NULL then the corresponding
  55.                  * file isn't open.  If tclOpenFiles is NULL
  56.                  * it means no files have been used, so even
  57.                  * stdin/stdout/stderr entries haven't been
  58.                  * setup yet. */
  59.  
  60. /*
  61.  * Declarations for local procedures defined in this file:
  62.  */
  63.  
  64. static int        FileForRedirect _ANSI_ARGS_((Tcl_Interp *interp,
  65.                 char *spec, int atOk, char *arg, int flags,
  66.                 char *nextArg, int *skipPtr, int *closePtr));
  67. static void        MakeFileTable _ANSI_ARGS_((Interp *iPtr, int index));
  68. static void        RestoreSignals _ANSI_ARGS_((void));
  69.  
  70. /*
  71.  *----------------------------------------------------------------------
  72.  *
  73.  * Tcl_EvalFile --
  74.  *
  75.  *    Read in a file and process the entire file as one gigantic
  76.  *    Tcl command.
  77.  *
  78.  * Results:
  79.  *    A standard Tcl result, which is either the result of executing
  80.  *    the file or an error indicating why the file couldn't be read.
  81.  *
  82.  * Side effects:
  83.  *    Depends on the commands in the file.
  84.  *
  85.  *----------------------------------------------------------------------
  86.  */
  87.  
  88. int
  89. Tcl_EvalFile(interp, fileName)
  90.     Tcl_Interp *interp;        /* Interpreter in which to process file. */
  91.     char *fileName;        /* Name of file to process.  Tilde-substitution
  92.                  * will be performed on this name. */
  93. {
  94.     int fileId, result;
  95.     struct stat statBuf;
  96.     char *cmdBuffer, *oldScriptFile;
  97.     Interp *iPtr = (Interp *) interp;
  98.     Tcl_DString buffer;
  99.  
  100.     Tcl_ResetResult(interp);
  101.     oldScriptFile = iPtr->scriptFile;
  102.     iPtr->scriptFile = fileName;
  103.     fileName = Tcl_TildeSubst(interp, fileName, &buffer);
  104.     if (fileName == NULL) {
  105.     goto error;
  106.     }
  107.     fileId = open(fileName, O_RDONLY, 0);
  108.     if (fileId < 0) {
  109.     Tcl_AppendResult(interp, "couldn't read file \"", fileName,
  110.         "\": ", Tcl_PosixError(interp), (char *) NULL);
  111.     goto error;
  112.     }
  113.     if (fstat(fileId, &statBuf) == -1) {
  114.     Tcl_AppendResult(interp, "couldn't stat file \"", fileName,
  115.         "\": ", Tcl_PosixError(interp), (char *) NULL);
  116.     close(fileId);
  117.     goto error;
  118.     }
  119.     cmdBuffer = (char *) ckalloc((unsigned) statBuf.st_size+1);
  120.     if (read(fileId, cmdBuffer, (size_t) statBuf.st_size) != statBuf.st_size) {
  121.     Tcl_AppendResult(interp, "error in reading file \"", fileName,
  122.         "\": ", Tcl_PosixError(interp), (char *) NULL);
  123.     close(fileId);
  124.     ckfree(cmdBuffer);
  125.     goto error;
  126.     }
  127.     if (close(fileId) != 0) {
  128.     Tcl_AppendResult(interp, "error closing file \"", fileName,
  129.         "\": ", Tcl_PosixError(interp), (char *) NULL);
  130.     ckfree(cmdBuffer);
  131.     goto error;
  132.     }
  133.     cmdBuffer[statBuf.st_size] = 0;
  134.     result = Tcl_Eval(interp, cmdBuffer);
  135.     if (result == TCL_RETURN) {
  136.     result = TCL_OK;
  137.     }
  138.     if (result == TCL_ERROR) {
  139.     char msg[200];
  140.  
  141.     /*
  142.      * Record information telling where the error occurred.
  143.      */
  144.  
  145.     sprintf(msg, "\n    (file \"%.150s\" line %d)", fileName,
  146.         interp->errorLine);
  147.     Tcl_AddErrorInfo(interp, msg);
  148.     }
  149.     ckfree(cmdBuffer);
  150.     iPtr->scriptFile = oldScriptFile;
  151.     Tcl_DStringFree(&buffer);
  152.     return result;
  153.  
  154.     error:
  155.     iPtr->scriptFile = oldScriptFile;
  156.     Tcl_DStringFree(&buffer);
  157.     return TCL_ERROR;
  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.     int *pidPtr;        /* Array of pids to detach. */
  184. {
  185.     register Detached *detPtr;
  186.     int i;
  187.  
  188.     for (i = 0; i < numPids; i++) {
  189.     detPtr = (Detached *) ckalloc(sizeof(Detached));
  190.     detPtr->pid = pidPtr[i];
  191.     detPtr->nextPtr = detList;
  192.     detList = detPtr;
  193.     }
  194. }
  195.  
  196. /*
  197.  *----------------------------------------------------------------------
  198.  *
  199.  * Tcl_ReapDetachedProcs --
  200.  *
  201.  *    This procedure checks to see if any detached processes have
  202.  *    exited and, if so, it "reaps" them by officially waiting on
  203.  *    them.  It should be called "occasionally" to make sure that
  204.  *    all detached processes are eventually reaped.
  205.  *
  206.  * Results:
  207.  *    None.
  208.  *
  209.  * Side effects:
  210.  *    Processes are waited on, so that they can be reaped by the
  211.  *    system.
  212.  *
  213.  *----------------------------------------------------------------------
  214.  */
  215.  
  216. void
  217. Tcl_ReapDetachedProcs()
  218. {
  219.     register Detached *detPtr;
  220.     Detached *nextPtr, *prevPtr;
  221.     int status, result;
  222.  
  223.     for (detPtr = detList, prevPtr = NULL; detPtr != NULL; ) {
  224.     result = waitpid(detPtr->pid, &status, WNOHANG);
  225.     if ((result == 0) || ((result == -1) && (errno != ECHILD))) {
  226.         prevPtr = detPtr;
  227.         detPtr = detPtr->nextPtr;
  228.         continue;
  229.     }
  230.     nextPtr = detPtr->nextPtr;
  231.     if (prevPtr == NULL) {
  232.         detList = detPtr->nextPtr;
  233.     } else {
  234.         prevPtr->nextPtr = detPtr->nextPtr;
  235.     }
  236.     ckfree((char *) detPtr);
  237.     detPtr = nextPtr;
  238.     }
  239. }
  240.  
  241. /*
  242.  *----------------------------------------------------------------------
  243.  *
  244.  * Tcl_CreatePipeline --
  245.  *
  246.  *    Given an argc/argv array, instantiate a pipeline of processes
  247.  *    as described by the argv.
  248.  *
  249.  * Results:
  250.  *    The return value is a count of the number of new processes
  251.  *    created, or -1 if an error occurred while creating the pipeline.
  252.  *    *pidArrayPtr is filled in with the address of a dynamically
  253.  *    allocated array giving the ids of all of the processes.  It
  254.  *    is up to the caller to free this array when it isn't needed
  255.  *    anymore.  If inPipePtr is non-NULL, *inPipePtr is filled in
  256.  *    with the file id for the input pipe for the pipeline (if any):
  257.  *    the caller must eventually close this file.  If outPipePtr
  258.  *    isn't NULL, then *outPipePtr is filled in with the file id
  259.  *    for the output pipe from the pipeline:  the caller must close
  260.  *    this file.  If errFilePtr isn't NULL, then *errFilePtr is filled
  261.  *    with a file id that may be used to read error output after the
  262.  *    pipeline completes.
  263.  *
  264.  * Side effects:
  265.  *    Processes and pipes are created.
  266.  *
  267.  *----------------------------------------------------------------------
  268.  */
  269.  
  270. int
  271. Tcl_CreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
  272.     outPipePtr, errFilePtr)
  273.     Tcl_Interp *interp;        /* Interpreter to use for error reporting. */
  274.     int argc;            /* Number of entries in argv. */
  275.     char **argv;        /* Array of strings describing commands in
  276.                  * pipeline plus I/O redirection with <,
  277.                  * <<,  >, etc.  Argv[argc] must be NULL. */
  278.     int **pidArrayPtr;        /* Word at *pidArrayPtr gets filled in with
  279.                  * address of array of pids for processes
  280.                  * in pipeline (first pid is first process
  281.                  * in pipeline). */
  282.     int *inPipePtr;        /* If non-NULL, input to the pipeline comes
  283.                  * from a pipe (unless overridden by
  284.                  * redirection in the command).  The file
  285.                  * id with which to write to this pipe is
  286.                  * stored at *inPipePtr.  -1 means command
  287.                  * specified its own input source. */
  288.     int *outPipePtr;        /* If non-NULL, output to the pipeline goes
  289.                  * to a pipe, unless overriden by redirection
  290.                  * in the command.  The file id with which to
  291.                  * read frome this pipe is stored at
  292.                  * *outPipePtr.  -1 means command specified
  293.                  * its own output sink. */
  294.     int *errFilePtr;        /* If non-NULL, all stderr output from the
  295.                  * pipeline will go to a temporary file
  296.                  * created here, and a descriptor to read
  297.                  * the file will be left at *errFilePtr.
  298.                  * The file will be removed already, so
  299.                  * closing this descriptor will be the end
  300.                  * of the file.  If this is NULL, then
  301.                  * all stderr output goes to our stderr.
  302.                  * If the pipeline specifies redirection
  303.                  * then the fill will still be created
  304.                  * but it will never get any data. */
  305. {
  306.     int *pidPtr = NULL;        /* Points to malloc-ed array holding all
  307.                  * the pids of child processes. */
  308.     int numPids = 0;        /* Actual number of processes that exist
  309.                  * at *pidPtr right now. */
  310.     int cmdCount;        /* Count of number of distinct commands
  311.                  * found in argc/argv. */
  312.     char *input = NULL;        /* If non-null, then this points to a
  313.                  * string containing input data (specified
  314.                  * via <<) to be piped to the first process
  315.                  * in the pipeline. */
  316.     int inputId = -1;        /* If >= 0, gives file id to use as input for
  317.                  * first process in pipeline (specified via
  318.                  * < or <@). */
  319.     int closeInput = 0;        /* If non-zero, then must close inputId
  320.                  * when cleaning up (zero means the file needs
  321.                  * to stay open for some other reason). */
  322.     int outputId = -1;        /* Writable file id for output from last
  323.                  * command in pipeline (could be file or pipe).
  324.                  * -1 means use stdout. */
  325.     int closeOutput = 0;    /* Non-zero means must close outputId when
  326.                  * cleaning up (similar to closeInput). */
  327.     int errorId = -1;        /* Writable file id for error output from
  328.                  * all commands in pipeline. -1 means use
  329.                  * stderr. */
  330.     int closeError = 0;        /* Non-zero means must close errorId when
  331.                  * cleaning up. */
  332.     int pipeIds[2];        /* File ids for pipe that's being created. */
  333.     int firstArg, lastArg;    /* Indexes of first and last arguments in
  334.                  * current command. */
  335.     int skip;            /* Number of arguments to skip (because they
  336.                  * specify redirection). */
  337.     int maxFd;            /* Highest known file descriptor (used to
  338.                  * close off extraneous file descriptors in
  339.                  * child process). */
  340.     int errPipeIds[2];        /* Used for communication between parent and
  341.                  * child processes.  If child encounters
  342.                  * error during startup it returns error
  343.                  * message via pipe.  If child starts up
  344.                  * OK, it closes pipe without anything in
  345.                  * it. */
  346.     int lastBar;
  347.     char *execName;
  348.     int i, j, pid, count;
  349.     char *p;
  350.     Tcl_DString buffer;
  351.     char errSpace[200];
  352.  
  353.     if (inPipePtr != NULL) {
  354.     *inPipePtr = -1;
  355.     }
  356.     if (outPipePtr != NULL) {
  357.     *outPipePtr = -1;
  358.     }
  359.     if (errFilePtr != NULL) {
  360.     *errFilePtr = -1;
  361.     }
  362.     pipeIds[0] = pipeIds[1] = -1;
  363.     errPipeIds[0] = errPipeIds[1] = -1;
  364.  
  365.     /*
  366.      * First, scan through all the arguments to figure out the structure
  367.      * of the pipeline.  Process all of the input and output redirection
  368.      * arguments and remove them from the argument list in the pipeline.
  369.      * Count the number of distinct processes (it's the number of "|"
  370.      * arguments plus one) but don't remove the "|" arguments.
  371.      */
  372.  
  373.     cmdCount = 1;
  374.     lastBar = -1;
  375.     for (i = 0; i < argc; i++) {
  376.     if ((argv[i][0] == '|') && (((argv[i][1] == 0))
  377.         || ((argv[i][1] == '&') && (argv[i][2] == 0)))) {
  378.         if ((i == (lastBar+1)) || (i == (argc-1))) {
  379.         interp->result = "illegal use of | or |& in command";
  380.         return -1;
  381.         }
  382.         lastBar = i;
  383.         cmdCount++;
  384.         continue;
  385.     } else if (argv[i][0] == '<') {
  386.         if ((inputId >= 0) && closeInput) {
  387.         close(inputId);
  388.         }
  389.         inputId = -1;
  390.         skip = 1;
  391.         if (argv[i][1] == '<') {
  392.         input = argv[i]+2;
  393.         if (*input == 0) {
  394.             input = argv[i+1];
  395.             if (input == 0) {
  396.             Tcl_AppendResult(interp, "can't specify \"", argv[i],
  397.                 "\" as last word in command", (char *) NULL);
  398.             goto error;
  399.             }
  400.             skip = 2;
  401.         }
  402.         } else {
  403.         input = 0;
  404.         inputId = FileForRedirect(interp, argv[i]+1, 1, argv[i],
  405.             O_RDONLY, argv[i+1], &skip, &closeInput);
  406.         if (inputId < 0) {
  407.             goto error;
  408.         }
  409.         }
  410.     } else if (argv[i][0] == '>') {
  411.         int append, useForStdErr, useForStdOut, mustClose, fd, atOk, flags;
  412.  
  413.         skip = atOk = 1;
  414.         append = useForStdErr = 0;
  415.         useForStdOut = 1;
  416.         if (argv[i][1] == '>') {
  417.         p = argv[i] + 2;
  418.         append = 1;
  419.         atOk = 0;
  420.         flags = O_WRONLY|O_CREAT;
  421.         } else {
  422.         p = argv[i] + 1;
  423.         flags = O_WRONLY|O_CREAT|O_TRUNC;
  424.         }
  425.         if (*p == '&') {
  426.         useForStdErr = 1;
  427.         p++;
  428.         }
  429.         fd = FileForRedirect(interp, p, atOk, argv[i], flags, argv[i+1],
  430.             &skip, &mustClose);
  431.         if (fd < 0) {
  432.         goto error;
  433.         }
  434.         if (append) {
  435.         lseek(fd, 0L, 2);
  436.         }
  437.  
  438.         /*
  439.          * Got the file descriptor.  Now use it for standard output,
  440.          * standard error, or both, depending on the redirection.
  441.          */
  442.  
  443.         if (useForStdOut) {
  444.         if ((outputId > 0) && closeOutput) {
  445.             close(outputId);
  446.         }
  447.         outputId = fd;
  448.         closeOutput = mustClose;
  449.         }
  450.         if (useForStdErr) {
  451.         if ((errorId > 0) && closeError) {
  452.             close(errorId);
  453.         }
  454.         errorId = fd;
  455.         closeError = (useForStdOut) ? 0 : mustClose;
  456.         }
  457.     } else if ((argv[i][0] == '2') && (argv[i][1] == '>')) {
  458.         int append, atOk, flags;
  459.  
  460.         if ((errorId > 0) && closeError) {
  461.         close(errorId);
  462.         }
  463.         skip = 1;
  464.         p = argv[i] + 2;
  465.         if (*p == '>') {
  466.         p++;
  467.         append = 1;
  468.         atOk = 0;
  469.         flags = O_WRONLY|O_CREAT;
  470.         } else {
  471.         append = 0;
  472.         atOk = 1;
  473.         flags = O_WRONLY|O_CREAT|O_TRUNC;
  474.         }
  475.         errorId = FileForRedirect(interp, p, atOk, argv[i], flags,
  476.             argv[i+1], &skip, &closeError);
  477.         if (errorId < 0) {
  478.         goto error;
  479.         }
  480.         if (append) {
  481.         lseek(errorId, 0L, 2);
  482.         }
  483.     } else {
  484.         continue;
  485.     }
  486.     for (j = i+skip; j < argc; j++) {
  487.         argv[j-skip] = argv[j];
  488.     }
  489.     argc -= skip;
  490.     i -= 1;            /* Process next arg from same position. */
  491.     }
  492.     if (argc == 0) {
  493.     interp->result =  "didn't specify command to execute";
  494.     return -1;
  495.     }
  496.  
  497.     if (inputId < 0) {
  498.     if (input != NULL) {
  499.         char inName[L_tmpnam];
  500.         int length;
  501.  
  502.         /*
  503.          * The input for the first process is immediate data coming from
  504.          * Tcl.  Create a temporary file for it and put the data into the
  505.          * file.
  506.          */
  507.  
  508.         tmpnam(inName);
  509.         inputId = open(inName, O_RDWR|O_CREAT|O_TRUNC, 0600);
  510.         closeInput = 1;
  511.         if (inputId < 0) {
  512.         Tcl_AppendResult(interp,
  513.             "couldn't create input file \"", inName,
  514.             "\" for command: ", Tcl_PosixError(interp),
  515.             (char *) NULL);
  516.         goto error;
  517.         }
  518.         length = strlen(input);
  519.         if (write(inputId, input, (size_t) length) != length) {
  520.         Tcl_AppendResult(interp,
  521.             "couldn't write file input for command: ",
  522.             Tcl_PosixError(interp), (char *) NULL);
  523.         goto error;
  524.         }
  525.         if ((lseek(inputId, 0L, 0) == -1) || (unlink(inName) == -1)) {
  526.         Tcl_AppendResult(interp,
  527.             "couldn't reset or remove input file for command: ",
  528.             Tcl_PosixError(interp), (char *) NULL);
  529.         goto error;
  530.         }
  531.     } else if (inPipePtr != NULL) {
  532.         /*
  533.          * The input for the first process in the pipeline is to
  534.          * come from a pipe that can be written from this end.
  535.          */
  536.  
  537.         if (pipe(pipeIds) != 0) {
  538.         Tcl_AppendResult(interp,
  539.             "couldn't create input pipe for command: ",
  540.             Tcl_PosixError(interp), (char *) NULL);
  541.         goto error;
  542.         }
  543.         inputId = pipeIds[0];
  544.         closeInput = 1;
  545.         *inPipePtr = pipeIds[1];
  546.         pipeIds[0] = pipeIds[1] = -1;
  547.     }
  548.     }
  549.  
  550.     /*
  551.      * Set up a pipe to receive output from the pipeline, if no other
  552.      * output sink has been specified.
  553.      */
  554.  
  555.     if ((outputId < 0) && (outPipePtr != NULL)) {
  556.     if (pipe(pipeIds) != 0) {
  557.         Tcl_AppendResult(interp,
  558.             "couldn't create output pipe: ",
  559.             Tcl_PosixError(interp), (char *) NULL);
  560.         goto error;
  561.     }
  562.     outputId = pipeIds[1];
  563.     closeOutput = 1;
  564.     *outPipePtr = pipeIds[0];
  565.     pipeIds[0] = pipeIds[1] = -1;
  566.     }
  567.  
  568.     /*
  569.      * Set up the standard error output sink for the pipeline, if
  570.      * requested.  Use a temporary file which is opened, then deleted.
  571.      * Could potentially just use pipe, but if it filled up it could
  572.      * cause the pipeline to deadlock:  we'd be waiting for processes
  573.      * to complete before reading stderr, and processes couldn't complete
  574.      * because stderr was backed up.
  575.      */
  576.  
  577.     if (errFilePtr != NULL) {
  578.     char errName[L_tmpnam];
  579.  
  580.     tmpnam(errName);
  581.     *errFilePtr = open(errName, O_RDONLY|O_CREAT|O_TRUNC, 0600);
  582.     if (*errFilePtr < 0) {
  583.         errFileError:
  584.         Tcl_AppendResult(interp,
  585.             "couldn't create error file \"", errName,
  586.             "\" for command: ", Tcl_PosixError(interp),
  587.             (char *) NULL);
  588.         goto error;
  589.     }
  590.     if (errorId < 0) {
  591.         errorId = open(errName, O_WRONLY|O_CREAT|O_TRUNC, 0600);
  592.         if (errorId < 0) {
  593.         goto errFileError;
  594.         }
  595.         closeError = 1;
  596.     }
  597.     if (unlink(errName) == -1) {
  598.         Tcl_AppendResult(interp,
  599.             "couldn't remove error file for command: ",
  600.             Tcl_PosixError(interp), (char *) NULL);
  601.         goto error;
  602.     }
  603.     }
  604.  
  605.     /*
  606.      * Find the largest file descriptor used so far, so that we can
  607.      * clean up all the extraneous file descriptors in the child
  608.      * processes we create.
  609.      */
  610.  
  611.     maxFd = inputId;
  612.     if (outputId > maxFd) {
  613.     maxFd = outputId;
  614.     }
  615.     if (errorId > maxFd) {
  616.     maxFd = errorId;
  617.     }
  618.     if ((inPipePtr != NULL) && (*inPipePtr > maxFd)) {
  619.     maxFd = *inPipePtr;
  620.     }
  621.     if ((outPipePtr != NULL) && (*outPipePtr > maxFd)) {
  622.     maxFd = *outPipePtr;
  623.     }
  624.     if ((errFilePtr != NULL) && (*errFilePtr > maxFd)) {
  625.     maxFd = *errFilePtr;
  626.     }
  627.  
  628.     /*
  629.      * Scan through the argc array, forking off a process for each
  630.      * group of arguments between "|" arguments.
  631.      */
  632.  
  633.     pidPtr = (int *) ckalloc((unsigned) (cmdCount * sizeof(int)));
  634.     for (i = 0; i < numPids; i++) {
  635.     pidPtr[i] = -1;
  636.     }
  637.     Tcl_ReapDetachedProcs();
  638.     for (firstArg = 0; firstArg < argc; numPids++, firstArg = lastArg+1) {
  639.     int joinThisError;
  640.     int curOutputId;
  641.  
  642.     joinThisError = 0;
  643.     for (lastArg = firstArg; lastArg < argc; lastArg++) {
  644.         if (argv[lastArg][0] == '|') {
  645.         if (argv[lastArg][1] == 0) {
  646.             break;
  647.         }
  648.         if ((argv[lastArg][1] == '&') && (argv[lastArg][2] == 0)) {
  649.             joinThisError = 1;
  650.             break;
  651.         }
  652.         }
  653.     }
  654.     argv[lastArg] = NULL;
  655.     if (lastArg == argc) {
  656.         curOutputId = outputId;
  657.     } else {
  658.         if (pipe(pipeIds) != 0) {
  659.         Tcl_AppendResult(interp, "couldn't create pipe: ",
  660.             Tcl_PosixError(interp), (char *) NULL);
  661.         goto error;
  662.         }
  663.         curOutputId = pipeIds[1];
  664.         if (pipeIds[0] > maxFd) {
  665.         maxFd = pipeIds[0];
  666.         }
  667.         if (pipeIds[1] > maxFd) {
  668.         maxFd = pipeIds[1];
  669.         }
  670.     }
  671.  
  672.     /*
  673.      * Create a pipe that the child can use to return error
  674.      * information if anything goes wrong.  Set the close-on-exec
  675.      * flag for the write end of the pipe so that it will be
  676.      * closed automatically if the child succesfully execs the
  677.      * new subprocess.
  678.      */
  679.  
  680.     if (pipe(errPipeIds) != 0) {
  681.         Tcl_AppendResult(interp, "couldn't create pipe: ",
  682.             Tcl_PosixError(interp), (char *) NULL);
  683.         goto error;
  684.     }
  685.     if (errPipeIds[0] > maxFd) {
  686.         maxFd = errPipeIds[0];
  687.     }
  688.     if (errPipeIds[1] > maxFd) {
  689.         maxFd = errPipeIds[1];
  690.     }
  691.     if (fcntl(errPipeIds[1], F_SETFD, FD_CLOEXEC) != 0) {
  692.         Tcl_AppendResult(interp, "couldn't set close on exec for pipe: ",
  693.             Tcl_PosixError(interp), (char *) NULL);
  694.         goto error;
  695.     }
  696.     execName = Tcl_TildeSubst(interp, argv[firstArg], &buffer);
  697.     pid = vfork();
  698.     if (pid == 0) {
  699.         if (((inputId != -1) && (dup2(inputId, 0) == -1))
  700.             || ((curOutputId != -1) && (dup2(curOutputId, 1) == -1))
  701.             || (joinThisError && (dup2(1, 2) == -1))
  702.             || (!joinThisError && (errorId != -1)
  703.                 && (dup2(errorId, 2) == -1))) {
  704.         sprintf(errSpace,
  705.             "%dforked process couldn't set up input/output: ",
  706.             errno);
  707.         write(errPipeIds[1], errSpace, (size_t) strlen(errSpace));
  708.         _exit(1);
  709.         }
  710.         for (i = 3; i <= maxFd; i++) {
  711.         if (i != errPipeIds[1]) {
  712.             close(i);
  713.         }
  714.         }
  715.         RestoreSignals();
  716.         execvp(execName, &argv[firstArg]);
  717.         sprintf(errSpace, "%dcouldn't execute \"%.150s\": ", errno,
  718.             argv[firstArg]);
  719.         write(errPipeIds[1], errSpace, (size_t) strlen(errSpace));
  720.         _exit(1);
  721.     }
  722.     Tcl_DStringFree(&buffer);
  723.     if (pid == -1) {
  724.         Tcl_AppendResult(interp, "couldn't fork child process: ",
  725.             Tcl_PosixError(interp), (char *) NULL);
  726.         goto error;
  727.     }
  728.  
  729.     /*
  730.      * Read back from the error pipe to see if the child startup
  731.      * up OK.  The info in the pipe (if any) consists of a decimal
  732.      * errno value followed by an error message.
  733.      */
  734.  
  735.     close(errPipeIds[1]);
  736.     errPipeIds[1] = -1;
  737.     count = read(errPipeIds[0], errSpace, (size_t) (sizeof(errSpace) - 1));
  738.     if (count > 0) {
  739.         char *end;
  740.         errSpace[count] = 0;
  741.         errno = strtol(errSpace, &end, 10);
  742.         Tcl_AppendResult(interp, end, Tcl_PosixError(interp),
  743.             (char *) NULL);
  744.         goto error;
  745.     }
  746.     close(errPipeIds[0]);
  747.     errPipeIds[0] = -1;
  748.     pidPtr[numPids] = pid;
  749.  
  750.     /*
  751.      * Close off our copies of file descriptors that were set up for
  752.      * this child, then set up the input for the next child.
  753.      */
  754.  
  755.     if ((inputId != -1) && closeInput) {
  756.         close(inputId);
  757.     }
  758.     if ((curOutputId != -1) && (curOutputId != outputId)) {
  759.         close(curOutputId);
  760.     }
  761.     inputId = pipeIds[0];
  762.     closeInput = 1;
  763.     pipeIds[0] = pipeIds[1] = -1;
  764.     }
  765.     *pidArrayPtr = pidPtr;
  766.  
  767.     /*
  768.      * All done.  Cleanup open files lying around and then return.
  769.      */
  770.  
  771. cleanup:
  772.     if ((inputId != -1) && closeInput) {
  773.     close(inputId);
  774.     }
  775.     if ((outputId != -1) && closeOutput) {
  776.     close(outputId);
  777.     }
  778.     if ((errorId != -1) && closeError) {
  779.     close(errorId);
  780.     }
  781.     return numPids;
  782.  
  783.     /*
  784.      * An error occurred.  There could have been extra files open, such
  785.      * as pipes between children.  Clean them all up.  Detach any child
  786.      * processes that have been created.
  787.      */
  788.  
  789.     error:
  790.     if ((inPipePtr != NULL) && (*inPipePtr != -1)) {
  791.     close(*inPipePtr);
  792.     *inPipePtr = -1;
  793.     }
  794.     if ((outPipePtr != NULL) && (*outPipePtr != -1)) {
  795.     close(*outPipePtr);
  796.     *outPipePtr = -1;
  797.     }
  798.     if ((errFilePtr != NULL) && (*errFilePtr != -1)) {
  799.     close(*errFilePtr);
  800.     *errFilePtr = -1;
  801.     }
  802.     if (pipeIds[0] != -1) {
  803.     close(pipeIds[0]);
  804.     }
  805.     if (pipeIds[1] != -1) {
  806.     close(pipeIds[1]);
  807.     }
  808.     if (errPipeIds[0] != -1) {
  809.     close(errPipeIds[0]);
  810.     }
  811.     if (errPipeIds[1] != -1) {
  812.     close(errPipeIds[1]);
  813.     }
  814.     if (pidPtr != NULL) {
  815.     for (i = 0; i < numPids; i++) {
  816.         if (pidPtr[i] != -1) {
  817.         Tcl_DetachPids(1, &pidPtr[i]);
  818.         }
  819.     }
  820.     ckfree((char *) pidPtr);
  821.     }
  822.     numPids = -1;
  823.     goto cleanup;
  824. }
  825.  
  826. /*
  827.  *----------------------------------------------------------------------
  828.  *
  829.  * FileForRedirect --
  830.  *
  831.  *    This procedure does much of the work of parsing redirection
  832.  *    operators.  It handles "@" if specified and allowed, and a file
  833.  *    name, and opens the file if necessary.
  834.  *
  835.  * Results:
  836.  *    The return value is the descriptor number for the file.  If an
  837.  *    error occurs then -1 is returned and an error message is left
  838.  *    in interp->result.  Several arguments are side-effected; see
  839.  *    the argument list below for details.
  840.  *
  841.  * Side effects:
  842.  *    None.
  843.  *
  844.  *----------------------------------------------------------------------
  845.  */
  846.  
  847. static int
  848. FileForRedirect(interp, spec, atOk, arg, flags, nextArg, skipPtr, closePtr)
  849.     Tcl_Interp *interp;            /* Intepreter to use for error
  850.                      * reporting. */
  851.     register char *spec;            /* Points to character just after
  852.                      * redirection character. */
  853.     int atOk;                /* Non-zero means '@' notation is
  854.                      * OK, zero means it isn't. */
  855.     char *arg;                /* Pointer to entire argument
  856.                      * containing spec:  used for error
  857.                      * reporting. */
  858.     int flags;                /* Flags to use for opening file. */
  859.     char *nextArg;            /* Next argument in argc/argv
  860.                      * array, if needed for file name.
  861.                      * May be NULL. */
  862.     int *skipPtr;            /* This value is incremented if
  863.                      * nextArg is used for redirection
  864.                      * spec. */
  865.     int *closePtr;            /* This value is set to 1 if the file
  866.                      * that's returned must be closed, 0
  867.                      * if it was specified with "@" so
  868.                      * it must be left open. */
  869. {
  870.     int writing = (flags & O_WRONLY);
  871.     FILE *f;
  872.     int fd;
  873.  
  874.     if (atOk && (*spec == '@')) {
  875.     spec++;
  876.     if (*spec == 0) {
  877.         spec = nextArg;
  878.         if (spec == NULL) {
  879.         goto badLastArg;
  880.         }
  881.         *skipPtr += 1;
  882.     }
  883.     if (Tcl_GetOpenFile(interp, spec, writing, 1, &f) != TCL_OK) {
  884.         return -1;
  885.     }
  886.     *closePtr = 0;
  887.     fd = fileno(f);
  888.     if (writing) {
  889.         /*
  890.          * Be sure to flush output to the file, so that anything
  891.          * written by the child appears after stuff we've already
  892.          * written.
  893.          */
  894.  
  895.         fflush(f);
  896.     }
  897.     } else {
  898.     if (*spec == 0) {
  899.         spec = nextArg;
  900.         if (spec == NULL) {
  901.         goto badLastArg;
  902.         }
  903.         *skipPtr += 1;
  904.     }
  905.     fd = open(spec, flags, 0666);
  906.     if (fd < 0) {
  907.         Tcl_AppendResult(interp, "couldn't ",
  908.             (writing) ? "write" : "read", " file \"", spec, "\": ",
  909.             Tcl_PosixError(interp), (char *) NULL);
  910.         return -1;
  911.     }
  912.     *closePtr = 1;
  913.     }
  914.     return fd;
  915.  
  916.     badLastArg:
  917.     Tcl_AppendResult(interp, "can't specify \"", arg,
  918.         "\" as last word in command", (char *) NULL);
  919.     return -1;
  920. }
  921.  
  922. /*
  923.  *----------------------------------------------------------------------
  924.  *
  925.  * RestoreSignals --
  926.  *
  927.  *    This procedure is invoked in a forked child process just before
  928.  *    exec-ing a new program to restore all signals to their default
  929.  *    settings.
  930.  *
  931.  * Results:
  932.  *    None.
  933.  *
  934.  * Side effects:
  935.  *    Signal settings get changed.
  936.  *
  937.  *----------------------------------------------------------------------
  938.  */
  939.  
  940. static void
  941. RestoreSignals()
  942. {
  943. #ifdef SIGABRT
  944.     signal(SIGABRT, SIG_DFL);
  945. #endif
  946. #ifdef SIGALRM
  947.     signal(SIGALRM, SIG_DFL);
  948. #endif
  949. #ifdef SIGFPE
  950.     signal(SIGFPE, SIG_DFL);
  951. #endif
  952. #ifdef SIGHUP
  953.     signal(SIGHUP, SIG_DFL);
  954. #endif
  955. #ifdef SIGILL
  956.     signal(SIGILL, SIG_DFL);
  957. #endif
  958. #ifdef SIGINT
  959.     signal(SIGINT, SIG_DFL);
  960. #endif
  961. #ifdef SIGPIPE
  962.     signal(SIGPIPE, SIG_DFL);
  963. #endif
  964. #ifdef SIGQUIT
  965.     signal(SIGQUIT, SIG_DFL);
  966. #endif
  967. #ifdef SIGSEGV
  968.     signal(SIGSEGV, SIG_DFL);
  969. #endif
  970. #ifdef SIGTERM
  971.     signal(SIGTERM, SIG_DFL);
  972. #endif
  973. #ifdef SIGUSR1
  974.     signal(SIGUSR1, SIG_DFL);
  975. #endif
  976. #ifdef SIGUSR2
  977.     signal(SIGUSR2, SIG_DFL);
  978. #endif
  979. #ifdef SIGCHLD
  980.     signal(SIGCHLD, SIG_DFL);
  981. #endif
  982. #ifdef SIGCONT
  983.     signal(SIGCONT, SIG_DFL);
  984. #endif
  985. #ifdef SIGTSTP
  986.     signal(SIGTSTP, SIG_DFL);
  987. #endif
  988. #ifdef SIGTTIN
  989.     signal(SIGTTIN, SIG_DFL);
  990. #endif
  991. #ifdef SIGTTOU
  992.     signal(SIGTTOU, SIG_DFL);
  993. #endif
  994. }
  995.  
  996. /*
  997.  *----------------------------------------------------------------------
  998.  *
  999.  * Tcl_PosixError --
  1000.  *
  1001.  *    This procedure is typically called after UNIX kernel calls
  1002.  *    return errors.  It stores machine-readable information about
  1003.  *    the error in $errorCode returns an information string for
  1004.  *    the caller's use.
  1005.  *
  1006.  * Results:
  1007.  *    The return value is a human-readable string describing the
  1008.  *    error, as returned by strerror.
  1009.  *
  1010.  * Side effects:
  1011.  *    The global variable $errorCode is reset.
  1012.  *
  1013.  *----------------------------------------------------------------------
  1014.  */
  1015.  
  1016. char *
  1017. Tcl_PosixError(interp)
  1018.     Tcl_Interp *interp;        /* Interpreter whose $errorCode variable
  1019.                  * is to be changed. */
  1020. {
  1021.     char *id, *msg;
  1022.  
  1023.     id = Tcl_ErrnoId();
  1024.     msg = strerror(errno);
  1025.     Tcl_SetErrorCode(interp, "POSIX", id, msg, (char *) NULL);
  1026.     return msg;
  1027. }
  1028.  
  1029. /*
  1030.  *----------------------------------------------------------------------
  1031.  *
  1032.  * MakeFileTable --
  1033.  *
  1034.  *    Create or enlarge the file table for the interpreter, so that
  1035.  *    there is room for a given index.
  1036.  *
  1037.  * Results:
  1038.  *    None.
  1039.  *
  1040.  * Side effects:
  1041.  *    The file table for iPtr will be created if it doesn't exist
  1042.  *    (and entries will be added for stdin, stdout, and stderr).
  1043.  *    If it already exists, then it will be grown if necessary.
  1044.  *
  1045.  *----------------------------------------------------------------------
  1046.  */
  1047.  
  1048.     /* ARGSUSED */
  1049. static void
  1050. MakeFileTable(iPtr, index)
  1051.     Interp *iPtr;        /* Interpreter whose table of files is
  1052.                  * to be manipulated. */
  1053.     int index;            /* Make sure table is large enough to
  1054.                  * hold at least this index. */
  1055. {
  1056.     /*
  1057.      * If the table doesn't even exist, then create it and initialize
  1058.      * entries for standard files.
  1059.      */
  1060.  
  1061.     if (tclNumFiles == 0) {
  1062.     OpenFile *oFilePtr;
  1063.     int i;
  1064.  
  1065.     if (index < 2) {
  1066.         tclNumFiles = 3;
  1067.     } else {
  1068.         tclNumFiles = index+1;
  1069.     }
  1070.     tclOpenFiles = (OpenFile **) ckalloc((unsigned)
  1071.         ((tclNumFiles)*sizeof(OpenFile *)));
  1072.     for (i = tclNumFiles-1; i >= 0; i--) {
  1073.         tclOpenFiles[i] = NULL;
  1074.     }
  1075.  
  1076.     oFilePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
  1077.     oFilePtr->f = stdin;
  1078.     oFilePtr->f2 = NULL;
  1079.     oFilePtr->permissions = TCL_FILE_READABLE;
  1080.     oFilePtr->numPids = 0;
  1081.     oFilePtr->pidPtr = NULL;
  1082.     oFilePtr->errorId = -1;
  1083.     tclOpenFiles[0] = oFilePtr;
  1084.  
  1085.     oFilePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
  1086.     oFilePtr->f = stdout;
  1087.     oFilePtr->f2 = NULL;
  1088.     oFilePtr->permissions = TCL_FILE_WRITABLE;
  1089.     oFilePtr->numPids = 0;
  1090.     oFilePtr->pidPtr = NULL;
  1091.     oFilePtr->errorId = -1;
  1092.     tclOpenFiles[1] = oFilePtr;
  1093.  
  1094.     oFilePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
  1095.     oFilePtr->f = stderr;
  1096.     oFilePtr->f2 = NULL;
  1097.     oFilePtr->permissions = TCL_FILE_WRITABLE;
  1098.     oFilePtr->numPids = 0;
  1099.     oFilePtr->pidPtr = NULL;
  1100.     oFilePtr->errorId = -1;
  1101.     tclOpenFiles[2] = oFilePtr;
  1102.     } else if (index >= tclNumFiles) {
  1103.     int newSize;
  1104.     OpenFile **newPtrArray;
  1105.     int i;
  1106.  
  1107.     newSize = index+1;
  1108.     newPtrArray = (OpenFile **) ckalloc((unsigned)
  1109.         ((newSize)*sizeof(OpenFile *)));
  1110.     memcpy((VOID *) newPtrArray, (VOID *) tclOpenFiles,
  1111.         tclNumFiles*sizeof(OpenFile *));
  1112.     for (i = tclNumFiles; i < newSize; i++) {
  1113.         newPtrArray[i] = NULL;
  1114.     }
  1115.     ckfree((char *) tclOpenFiles);
  1116.     tclNumFiles = newSize;
  1117.     tclOpenFiles = newPtrArray;
  1118.     }
  1119. }
  1120.  
  1121. /*
  1122.  *----------------------------------------------------------------------
  1123.  *
  1124.  * Tcl_EnterFile --
  1125.  *
  1126.  *    This procedure is used to enter an already-open file into the
  1127.  *    file table for an interpreter so that the file can be read
  1128.  *    and written with Tcl commands.
  1129.  *
  1130.  * Results:
  1131.  *    There is no return value, but interp->result is set to
  1132.  *    hold Tcl's id for the open file, such as "file4".
  1133.  *
  1134.  * Side effects:
  1135.  *    "File" is added to the files accessible from interp.
  1136.  *
  1137.  *----------------------------------------------------------------------
  1138.  */
  1139.  
  1140. void
  1141. Tcl_EnterFile(interp, file, permissions)
  1142.     Tcl_Interp *interp;        /* Interpreter in which to make file
  1143.                  * available. */
  1144.     FILE *file;            /* File to make available in interp. */
  1145.     int permissions;        /* Ops that may be done on file:  OR-ed
  1146.                  * combinination of TCL_FILE_READABLE and
  1147.                  * TCL_FILE_WRITABLE. */
  1148. {
  1149.     Interp *iPtr = (Interp *) interp;
  1150.     int fd;
  1151.     register OpenFile *oFilePtr;
  1152.  
  1153.     fd = fileno(file);
  1154.     if (fd >= tclNumFiles) {
  1155.     MakeFileTable(iPtr, fd);
  1156.     }
  1157.     oFilePtr = tclOpenFiles[fd];
  1158.  
  1159.     /*
  1160.      * It's possible that there already appears to be a file open in
  1161.      * the slot.  This could happen, for example, if the application
  1162.      * closes a file behind our back so that we don't have a chance
  1163.      * to clean up.  This is probably a bad idea, but if it happens
  1164.      * just discard the information in the old record (hopefully the
  1165.      * application is smart enough to have really cleaned everything
  1166.      * up right).
  1167.      */
  1168.  
  1169.     if (oFilePtr == NULL) {
  1170.     oFilePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
  1171.     tclOpenFiles[fd] = oFilePtr;
  1172.     }
  1173.     oFilePtr->f = file;
  1174.     oFilePtr->f2 = NULL;
  1175.     oFilePtr->permissions = permissions;
  1176.     oFilePtr->numPids = 0;
  1177.     oFilePtr->pidPtr = NULL;
  1178.     oFilePtr->errorId = -1;
  1179.     if (fd <= 2) {
  1180.     if (fd == 0) {
  1181.         interp->result = "stdin";
  1182.     } else if (fd == 1) {
  1183.         interp->result = "stdout";
  1184.     } else {
  1185.         interp->result = "stderr";
  1186.     }
  1187.     } else {
  1188.     sprintf(interp->result, "file%d", fd);
  1189.     }
  1190. }
  1191.  
  1192. /*
  1193.  *----------------------------------------------------------------------
  1194.  *
  1195.  * Tcl_GetOpenFile --
  1196.  *
  1197.  *    Given a string identifier for an open file, find the corresponding
  1198.  *    open file structure, if there is one.
  1199.  *
  1200.  * Results:
  1201.  *    A standard Tcl return value.  If the open file is successfully
  1202.  *    located and meets any usage check requested by checkUsage, TCL_OK
  1203.  *    is returned and *filePtr is modified to hold a pointer to its
  1204.  *    FILE structure.  If an error occurs then TCL_ERROR is returned
  1205.  *    and interp->result contains an error message.
  1206.  *
  1207.  * Side effects:
  1208.  *    None.
  1209.  *
  1210.  *----------------------------------------------------------------------
  1211.  */
  1212.  
  1213. int
  1214. Tcl_GetOpenFile(interp, string, forWriting, checkUsage, filePtr)
  1215.     Tcl_Interp *interp;        /* Interpreter in which to find file. */
  1216.     char *string;        /* String that identifies file. */
  1217.     int forWriting;        /* 1 means the file is going to be used
  1218.                  * for writing, 0 means for reading. */
  1219.     int checkUsage;        /* 1 means verify that the file was opened
  1220.                  * in a mode that allows the access specified
  1221.                  * by "forWriting". */
  1222.     FILE **filePtr;        /* Store pointer to FILE structure here. */
  1223. {
  1224.     OpenFile *oFilePtr;
  1225.     int fd = 0;            /* Initial value needed only to stop compiler
  1226.                  * warnings. */
  1227.     Interp *iPtr = (Interp *) interp;
  1228.  
  1229.     if ((string[0] == 'f') && (string[1] == 'i') && (string[2] == 'l')
  1230.         & (string[3] == 'e')) {
  1231.     char *end;
  1232.  
  1233.     fd = strtoul(string+4, &end, 10);
  1234.     if ((end == string+4) || (*end != 0)) {
  1235.         goto badId;
  1236.     }
  1237.     } else if ((string[0] == 's') && (string[1] == 't')
  1238.         && (string[2] == 'd')) {
  1239.     if (strcmp(string+3, "in") == 0) {
  1240.         fd = 0;
  1241.     } else if (strcmp(string+3, "out") == 0) {
  1242.         fd = 1;
  1243.     } else if (strcmp(string+3, "err") == 0) {
  1244.         fd = 2;
  1245.     } else {
  1246.         goto badId;
  1247.     }
  1248.     } else {
  1249.     badId:
  1250.     Tcl_AppendResult(interp, "bad file identifier \"", string,
  1251.         "\"", (char *) NULL);
  1252.     return TCL_ERROR;
  1253.     }
  1254.  
  1255.     if (fd >= tclNumFiles) {
  1256.     if ((tclNumFiles == 0) && (fd <= 2)) {
  1257.         MakeFileTable(iPtr, fd);
  1258.     } else {
  1259.         notOpen:
  1260.         Tcl_AppendResult(interp, "file \"", string, "\" isn't open",
  1261.             (char *) NULL);
  1262.         return TCL_ERROR;
  1263.     }
  1264.     }
  1265.     oFilePtr = tclOpenFiles[fd];
  1266.     if (oFilePtr == NULL) {
  1267.     goto notOpen;
  1268.     }
  1269.     if (forWriting) {
  1270.     if (checkUsage && !(oFilePtr->permissions & TCL_FILE_WRITABLE)) {
  1271.         Tcl_AppendResult(interp, "\"", string,
  1272.             "\" wasn't opened for writing", (char *) NULL);
  1273.         return TCL_ERROR;
  1274.     }
  1275.     if (oFilePtr->f2 != NULL) {
  1276.         *filePtr = oFilePtr->f2;
  1277.     } else {
  1278.         *filePtr = oFilePtr->f;
  1279.     }
  1280.     } else {
  1281.     if (checkUsage && !(oFilePtr->permissions & TCL_FILE_READABLE)) {
  1282.         Tcl_AppendResult(interp, "\"", string,
  1283.             "\" wasn't opened for reading", (char *) NULL);
  1284.         return TCL_ERROR;
  1285.     }
  1286.     *filePtr = oFilePtr->f;
  1287.     }
  1288.     return TCL_OK;
  1289. }
  1290.  
  1291. /*
  1292.  *----------------------------------------------------------------------
  1293.  *
  1294.  * Tcl_FilePermissions --
  1295.  *
  1296.  *    Given a FILE * pointer, return the read/write permissions
  1297.  *    associated with the open file.
  1298.  *
  1299.  * Results:
  1300.  *    If file is currently open, the return value is an OR-ed
  1301.  *    combination of TCL_FILE_READABLE and TCL_FILE_WRITABLE,
  1302.  *    which indicates the operations permitted on the open file.
  1303.  *    If the file isn't open then the return value is -1.
  1304.  *
  1305.  * Side effects:
  1306.  *    None.
  1307.  *
  1308.  *----------------------------------------------------------------------
  1309.  */
  1310.  
  1311. int
  1312. Tcl_FilePermissions(file)
  1313.     FILE *file;            /* File for which permissions are wanted. */
  1314. {
  1315.     register OpenFile *oFilePtr;
  1316.     int i, fd;
  1317.  
  1318.     /*
  1319.      * First try the entry in tclOpenFiles given by the file descriptor
  1320.      * for the file.  If that doesn't match then search all the entries
  1321.      * in tclOpenFiles.
  1322.      */
  1323.  
  1324.     if (file != NULL) {
  1325.     fd = fileno(file);
  1326.     if (fd < tclNumFiles) {
  1327.         oFilePtr = tclOpenFiles[fd];
  1328.         if ((oFilePtr != NULL) && (oFilePtr->f == file)) {
  1329.         return oFilePtr->permissions;
  1330.         }
  1331.     }
  1332.     }
  1333.     for (i = 0; i < tclNumFiles; i++) {
  1334.     oFilePtr = tclOpenFiles[i];
  1335.     if (oFilePtr == NULL) {
  1336.         continue;
  1337.     }
  1338.     if ((oFilePtr->f == file) || (oFilePtr->f2 == file)) {
  1339.         return oFilePtr->permissions;
  1340.     }
  1341.     }
  1342.     return -1;
  1343. }
  1344.  
  1345. /*
  1346.  *----------------------------------------------------------------------
  1347.  *
  1348.  * TclOpen, etc. --
  1349.  *
  1350.  *    Below are a bunch of procedures that are used by Tcl instead
  1351.  *    of system calls.  Each of the procedures executes the
  1352.  *    corresponding system call and retries automatically
  1353.  *    if the system call was interrupted by a signal.
  1354.  *
  1355.  * Results:
  1356.  *    Whatever the system call would normally return.
  1357.  *
  1358.  * Side effects:
  1359.  *    Whatever the system call would normally do.
  1360.  *
  1361.  * NOTE:
  1362.  *    This should be the last page of this file, since it undefines
  1363.  *    the macros that redirect read etc. to the procedures below.
  1364.  *
  1365.  *----------------------------------------------------------------------
  1366.  */
  1367.  
  1368. #undef open
  1369. int
  1370. TclOpen(path, oflag, mode)
  1371.     char *path;
  1372.     int oflag;
  1373.     int mode;
  1374. {
  1375.     int result;
  1376.     while (1) {
  1377.     result = open(path, oflag, mode);
  1378.     if ((result != -1) || (errno != EINTR)) {
  1379.         return result;
  1380.     }
  1381.     }
  1382. }
  1383.  
  1384. #undef read
  1385. int
  1386. TclRead(fd, buf, numBytes)
  1387.     int fd;
  1388.     VOID *buf;
  1389.     size_t numBytes;
  1390. {
  1391.     int result;
  1392.     while (1) {
  1393.     result = read(fd, buf, (size_t) numBytes);
  1394.     if ((result != -1) || (errno != EINTR)) {
  1395.         return result;
  1396.     }
  1397.     }
  1398. }
  1399.  
  1400. #undef waitpid
  1401. extern pid_t waitpid _ANSI_ARGS_((pid_t pid, int *stat_loc, int options));
  1402.  
  1403. /*
  1404.  * Note:  the #ifdef below is needed to avoid compiler errors on systems
  1405.  * that have ANSI compilers and also define pid_t to be short.  The
  1406.  * problem is a complex one having to do with argument type promotion.
  1407.  */
  1408.  
  1409. #ifdef _USING_PROTOTYPES_
  1410. int
  1411. TclWaitpid _ANSI_ARGS_((pid_t pid, int *statPtr, int options))
  1412. #else
  1413. int
  1414. TclWaitpid(pid, statPtr, options)
  1415.     pid_t pid;
  1416.     int *statPtr;
  1417.     int options;
  1418. #endif /* _USING_PROTOTYPES_ */
  1419. {
  1420.     int result;
  1421.     while (1) {
  1422.     result = waitpid(pid, statPtr, options);
  1423.     if ((result != -1) || (errno != EINTR)) {
  1424.         return result;
  1425.     }
  1426.     }
  1427. }
  1428.  
  1429. #undef write
  1430. int
  1431. TclWrite(fd, buf, numBytes)
  1432.     int fd;
  1433.     VOID *buf;
  1434.     size_t numBytes;
  1435. {
  1436.     int result;
  1437.     while (1) {
  1438.     result = write(fd, buf, (size_t) numBytes);
  1439.     if ((result != -1) || (errno != EINTR)) {
  1440.         return result;
  1441.     }
  1442.     }
  1443. }
  1444.