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