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