Usenet 1994 January/usenetsourcesnewsgroupsinfomagicjanuary1994.iso/sources/misc/volume25/tcl/part19

Text File | 1991-11-15 | 30.5 KB | 1,068 lines

Newsgroups: comp.sources.misc
From: [e-mail] (Karl Lehenbauer)
Subject:  v25i087:  tcl - tool command language, version 6.1, Part19/33
Message-ID: <[e-mail]>
X-Md4-Signature: eb1d37c9b084f03ff43c778c0763854b
Date: Fri, 15 Nov 1991 22:49:04 GMT
Approved: [e-mail]

Submitted-by: [e-mail] (Karl Lehenbauer)
Posting-number: Volume 25, Issue 87
Archive-name: tcl/part19
Environment: UNIX

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#        "End of archive 19 (of 33)."
# Contents:  tcl6.1/tclUnixUtil.c
# Wrapped by karl@one on Tue Nov 12 19:44:27 1991
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'tcl6.1/tclUnixUtil.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'tcl6.1/tclUnixUtil.c'\"
else
echo shar: Extracting \"'tcl6.1/tclUnixUtil.c'\" \(28034 characters\)
sed "s/^X//" >'tcl6.1/tclUnixUtil.c' <<'END_OF_FILE'
X/*
X * tclUnixUtil.c --
X *
X *    This file contains a collection of utility procedures that
X *    are present in the Tcl's UNIX core but not in the generic
X *    core.  For example, they do file manipulation and process
X *    manipulation.
X *
X *    The Tcl_Fork and Tcl_WaitPids procedures are based on code
X *    contributed by Karl Lehenbauer, Mark Diekhans and Peter
X *    da Silva.
X *
X * Copyright 1991 Regents of the University of California
X * Permission to use, copy, modify, and distribute this
X * software and its documentation for any purpose and without
X * fee is hereby granted, provided that this copyright
X * notice appears in all copies.  The University of California
X * makes no representations about the suitability of this
X * software for any purpose.  It is provided "as is" without
X * express or implied warranty.
X */
X
X#ifndef lint
Xstatic char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclUnixUtil.c,v 1.17 91/10/10 11:26:25 ouster Exp $ SPRITE (Berkeley)";
X#endif /* not lint */
X
X#include "tclInt.h"
X#include "tclUnix.h"
X
X/*
X * Data structures of the following type are used by Tcl_Fork and
X * Tcl_WaitPids to keep track of child processes.
X */
X
Xtypedef struct {
X    int pid;            /* Process id of child. */
X    WAIT_STATUS_TYPE status;    /* Status returned when child exited or
X                 * suspended. */
X    int flags;            /* Various flag bits;  see below for
X                 * definitions. */
X} WaitInfo;
X
X/*
X * Flag bits in WaitInfo structures:
X *
X * WI_READY -            Non-zero means process has exited or
X *                suspended since it was forked or last
X *                returned by Tcl_WaitPids.
X * WI_DETACHED -        Non-zero means no-one cares about the
X *                process anymore.  Ignore it until it
X *                exits, then forget about it.
X */
X
X#define WI_READY    1
X#define WI_DETACHED    2
X
Xstatic WaitInfo *waitTable = NULL;
Xstatic int waitTableSize = 0;    /* Total number of entries available in
X                 * waitTable. */
Xstatic int waitTableUsed = 0;    /* Number of entries in waitTable that
X                 * are actually in use right now.  Active
X                 * entries are always at the beginning
X                 * of the table. */
X#define WAIT_TABLE_GROW_BY 4
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_EvalFile --
X *
X *    Read in a file and process the entire file as one gigantic
X *    Tcl command.
X *
X * Results:
X *    A standard Tcl result, which is either the result of executing
X *    the file or an error indicating why the file couldn't be read.
X *
X * Side effects:
X *    Depends on the commands in the file.
X *
X *----------------------------------------------------------------------
X */
X
Xint
XTcl_EvalFile(interp, fileName)
X    Tcl_Interp *interp;        /* Interpreter in which to process file. */
X    char *fileName;        /* Name of file to process.  Tilde-substitution
X                 * will be performed on this name. */
X{
X    int fileId, result;
X    struct stat statBuf;
X    char *cmdBuffer, *end, *oldScriptFile;
X    Interp *iPtr = (Interp *) interp;
X
X    oldScriptFile = iPtr->scriptFile;
X    iPtr->scriptFile = fileName;
X    fileName = Tcl_TildeSubst(interp, fileName);
X    if (fileName == NULL) {
X    goto error;
X    }
X    fileId = open(fileName, O_RDONLY, 0);
X    if (fileId < 0) {
X    Tcl_AppendResult(interp, "couldn't read file \"", fileName,
X        "\": ", Tcl_UnixError(interp), (char *) NULL);
X    goto error;
X    }
X    if (fstat(fileId, &statBuf) == -1) {
X    Tcl_AppendResult(interp, "couldn't stat file \"", fileName,
X        "\": ", Tcl_UnixError(interp), (char *) NULL);
X    close(fileId);
X    goto error;
X    }
X    cmdBuffer = (char *) ckalloc((unsigned) statBuf.st_size+1);
X    if (read(fileId, cmdBuffer, (int) statBuf.st_size) != statBuf.st_size) {
X    Tcl_AppendResult(interp, "error in reading file \"", fileName,
X        "\": ", Tcl_UnixError(interp), (char *) NULL);
X    close(fileId);
X    goto error;
X    }
X    if (close(fileId) != 0) {
X    Tcl_AppendResult(interp, "error closing file \"", fileName,
X        "\": ", Tcl_UnixError(interp), (char *) NULL);
X    goto error;
X    }
X    cmdBuffer[statBuf.st_size] = 0;
X    result = Tcl_Eval(interp, cmdBuffer, 0, &end);
X    if (result == TCL_RETURN) {
X    result = TCL_OK;
X    }
X    if (result == TCL_ERROR) {
X    char msg[200];
X
X    /*
X     * Record information telling where the error occurred.
X     */
X
X    sprintf(msg, "\n    (file \"%.150s\" line %d)", fileName,
X        interp->errorLine);
X    Tcl_AddErrorInfo(interp, msg);
X    }
X    ckfree(cmdBuffer);
X    iPtr->scriptFile = oldScriptFile;
X    return result;
X
X    error:
X    iPtr->scriptFile = oldScriptFile;
X    return TCL_ERROR;
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_Fork --
X *
X *    Create a new process using the vfork system call, and keep
X *    track of it for "safe" waiting with Tcl_WaitPids.
X *
X * Results:
X *    The return value is the value returned by the vfork system
X *    call (0 means child, > 0 means parent (value is child id),
X *    < 0 means error).
X *
X * Side effects:
X *    A new process is created, and an entry is added to an internal
X *    table of child processes if the process is created successfully.
X *
X *----------------------------------------------------------------------
X */
X
Xint
XTcl_Fork()
X{
X    WaitInfo *waitPtr;
X    pid_t pid;
X
X    /*
X     * Disable SIGPIPE signals:  if they were allowed, this process
X     * might go away unexpectedly if children misbehave.  This code
X     * can potentially interfere with other application code that
X     * expects to handle SIGPIPEs;  what's really needed is an
X     * arbiter for signals to allow them to be "shared".
X     */
X
X    if (waitTable == NULL) {
X    (void) signal(SIGPIPE, SIG_IGN);
X    }
X
X    /*
X     * Enlarge the wait table if there isn't enough space for a new
X     * entry.
X     */
X
X    if (waitTableUsed == waitTableSize) {
X    int newSize;
X    WaitInfo *newWaitTable;
X
X    newSize = waitTableSize + WAIT_TABLE_GROW_BY;
X    newWaitTable = (WaitInfo *) ckalloc((unsigned)
X        (newSize * sizeof(WaitInfo)));
X    memcpy((VOID *) newWaitTable, (VOID *) waitTable,
X        (waitTableSize * sizeof(WaitInfo)));
X    if (waitTable != NULL) {
X        ckfree((char *) waitTable);
X    }
X    waitTable = newWaitTable;
X    waitTableSize = newSize;
X    }
X
X    /*
X     * Make a new process and enter it into the table if the fork
X     * is successful.
X     */
X
X    waitPtr = &waitTable[waitTableUsed];
X    pid = fork();
X    if (pid > 0) {
X    waitPtr->pid = pid;
X    waitPtr->flags = 0;
X    waitTableUsed++;
X    }
X    return pid;
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_WaitPids --
X *
X *    This procedure is used to wait for one or more processes created
X *    by Tcl_Fork to exit or suspend.  It records information about
X *    all processes that exit or suspend, even those not waited for,
X *    so that later waits for them will be able to get the status
X *    information.
X *
X * Results:
X *    -1 is returned if there is an error in the wait kernel call.
X *    Otherwise the pid of an exited/suspended process from *pidPtr
X *    is returned and *statusPtr is set to the status value returned
X *    by the wait kernel call.
X *
X * Side effects:
X *    Doesn't return until one of the pids at *pidPtr exits or suspends.
X *
X *----------------------------------------------------------------------
X */
X
Xint
XTcl_WaitPids(numPids, pidPtr, statusPtr)
X    int numPids;        /* Number of pids to wait on:  gives size
X                 * of array pointed to by pidPtr. */
X    int *pidPtr;        /* Pids to wait on:  return when one of
X                 * these processes exits or suspends. */
X    int *statusPtr;        /* Wait status is returned here. */
X{
X    int i, count, pid;
X    register WaitInfo *waitPtr;
X    int anyProcesses;
X    WAIT_STATUS_TYPE status;
X
X    while (1) {
X    /*
X     * Scan the table of child processes to see if one of the
X     * specified children has already exited or suspended.  If so,
X     * remove it from the table and return its status.
X     */
X
X    anyProcesses = 0;
X    for (waitPtr = waitTable, count = waitTableUsed;
X        count > 0; waitPtr++, count--) {
X        for (i = 0; i < numPids; i++) {
X        if (pidPtr[i] != waitPtr->pid) {
X            continue;
X        }
X        anyProcesses = 1;
X        if (waitPtr->flags & WI_READY) {
X            *statusPtr = *((int *) &waitPtr->status);
X            pid = waitPtr->pid;
X            if (WIFEXITED(waitPtr->status)
X                || WIFSIGNALED(waitPtr->status)) {
X            *waitPtr = waitTable[waitTableUsed-1];
X            waitTableUsed--;
X            } else {
X            waitPtr->flags &= ~WI_READY;
X            }
X            return pid;
X        }
X        }
X    }
X
X    /*
X     * Make sure that the caller at least specified one valid
X     * process to wait for.
X     */
X
X    if (!anyProcesses) {
X        errno = ECHILD;
X        return -1;
X    }
X
X    /*
X     * Wait for a process to exit or suspend, then update its
X     * entry in the table and go back to the beginning of the
X     * loop to see if it's one of the desired processes.
X     */
X
X    pid = wait(&status);
X    if (pid < 0) {
X        return pid;
X    }
X    for (waitPtr = waitTable, count = waitTableUsed; ;
X        waitPtr++, count--) {
X        if (count == 0) {
X        panic("Tcl_WaitPids got unknown process");
X        break;
X        }
X        if (pid != waitPtr->pid) {
X        continue;
X        }
X
X        /*
X         * If the process has been detached, then ignore anything
X         * other than an exit, and drop the entry on exit.
X         */
X
X        if (waitPtr->flags & WI_DETACHED) {
X        if (WIFEXITED(status) || WIFSIGNALED(status)) {
X            *waitPtr = waitTable[waitTableUsed-1];
X            waitTableUsed--;
X        }
X        } else {
X        waitPtr->status = status;
X        waitPtr->flags |= WI_READY;
X        }
X        break;
X    }
X    }
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_DetachPids --
X *
X *    This procedure is called to indicate that one or more child
X *    processes have been placed in background and are no longer
X *    cared about.  They should be ignored in future calls to
X *    Tcl_WaitPids.
X *
X * Results:
X *    None.
X *
X * Side effects:
X *    None.
X *
X *----------------------------------------------------------------------
X */
X
Xvoid
XTcl_DetachPids(numPids, pidPtr)
X    int numPids;        /* Number of pids to detach:  gives size
X                 * of array pointed to by pidPtr. */
X    int *pidPtr;        /* Array of pids to detach:  must have
X                 * been created by Tcl_Fork. */
X{
X    register WaitInfo *waitPtr;
X    int i, count, pid;
X
X    for (i = 0; i < numPids; i++) {
X    pid = pidPtr[i];
X    for (waitPtr = waitTable, count = waitTableUsed;
X        count > 0; waitPtr++, count--) {
X        if (pid != waitPtr->pid) {
X        continue;
X        }
X
X        /*
X         * If the process has already exited then destroy its
X         * table entry now.
X         */
X
X        if ((waitPtr->flags & WI_READY) && (WIFEXITED(waitPtr->status)
X            || WIFSIGNALED(waitPtr->status))) {
X        *waitPtr = waitTable[waitTableUsed-1];
X        waitTableUsed--;
X        } else {
X        waitPtr->flags |= WI_DETACHED;
X        }
X        goto nextPid;
X    }
X    panic("Tcl_Detach couldn't find process");
X
X    nextPid:
X    continue;
X    }
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_CreatePipeline --
X *
X *    Given an argc/argv array, instantiate a pipeline of processes
X *    as described by the argv.
X *
X * Results:
X *    The return value is a count of the number of new processes
X *    created, or -1 if an error occurred while creating the pipeline.
X *    *pidArrayPtr is filled in with the address of a dynamically
X *    allocated array giving the ids of all of the processes.  It
X *    is up to the caller to free this array when it isn't needed
X *    anymore.  If inPipePtr is non-NULL, *inPipePtr is filled in
X *    with the file id for the input pipe for the pipeline (if any):
X *    the caller must eventually close this file.  If outPipePtr
X *    isn't NULL, then *outPipePtr is filled in with the file id
X *    for the output pipe from the pipeline:  the caller must close
X *    this file.  If errFilePtr isn't NULL, then *errFilePtr is filled
X *    with a file id that may be used to read error output after the
X *    pipeline completes.
X *
X * Side effects:
X *    Processes and pipes are created.
X *
X *----------------------------------------------------------------------
X */
X
Xint
XTcl_CreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
X    outPipePtr, errFilePtr)
X    Tcl_Interp *interp;        /* Interpreter to use for error reporting. */
X    int argc;            /* Number of entries in argv. */
X    char **argv;        /* Array of strings describing commands in
X                 * pipeline plus I/O redirection with <,
X                 * <<, and >.  Argv[argc] must be NULL. */
X    int **pidArrayPtr;        /* Word at *pidArrayPtr gets filled in with
X                 * address of array of pids for processes
X                 * in pipeline (first pid is first process
X                 * in pipeline). */
X    int *inPipePtr;        /* If non-NULL, input to the pipeline comes
X                 * from a pipe (unless overridden by
X                 * redirection in the command).  The file
X                 * id with which to write to this pipe is
X                 * stored at *inPipePtr.  -1 means command
X                 * specified its own input source. */
X    int *outPipePtr;        /* If non-NULL, output to the pipeline goes
X                 * to a pipe, unless overriden by redirection
X                 * in the command.  The file id with which to
X                 * read frome this pipe is stored at
X                 * *outPipePtr.  -1 means command specified
X                 * its own output sink. */
X    int *errFilePtr;        /* If non-NULL, all stderr output from the
X                 * pipeline will go to a temporary file
X                 * created here, and a descriptor to read
X                 * the file will be left at *errFilePtr.
X                 * The file will be removed already, so
X                 * closing this descriptor will be the end
X                 * of the file.  If this is NULL, then
X                 * all stderr output goes to our stderr. */
X{
X    int *pidPtr = NULL;        /* Points to malloc-ed array holding all
X                 * the pids of child processes. */
X    int numPids = 0;        /* Actual number of processes that exist
X                 * at *pidPtr right now. */
X    int cmdCount;        /* Count of number of distinct commands
X                 * found in argc/argv. */
X    char *input = NULL;        /* Describes input for pipeline, depending
X                 * on "inputFile".  NULL means take input
X                 * from stdin/pipe. */
X    int inputFile = 0;        /* Non-zero means input is name of input
X                 * file.  Zero means input holds actual
X                 * text to be input to command. */
X    char *output = NULL;    /* Holds name of output file to pipe to,
X                 * or NULL if output goes to stdout/pipe. */
X    int inputId = -1;        /* Readable file id input to current command in
X                 * pipeline (could be file or pipe).  -1
X                 * means use stdin. */
X    int outputId = -1;        /* Writable file id for output from current
X                 * command in pipeline (could be file or pipe).
X                 * -1 means use stdout. */
X    int errorId = -1;        /* Writable file id for all standard error
X                 * output from all commands in pipeline.  -1
X                 * means use stderr. */
X    int lastOutputId = -1;    /* Write file id for output from last command
X                 * in pipeline (could be file or pipe).
X                 * -1 means use stdout. */
X    int pipeIds[2];        /* File ids for pipe that's being created. */
X    int firstArg, lastArg;    /* Indexes of first and last arguments in
X                 * current command. */
X    int lastBar;
X    char *execName;
X    int i, j, pid;
X
X    if (inPipePtr != NULL) {
X    *inPipePtr = -1;
X    }
X    if (outPipePtr != NULL) {
X    *outPipePtr = -1;
X    }
X    if (errFilePtr != NULL) {
X    *errFilePtr = -1;
X    }
X    pipeIds[0] = pipeIds[1] = -1;
X
X    /*
X     * First, scan through all the arguments to figure out the structure
X     * of the pipeline.  Count the number of distinct processes (it's the
X     * number of "|" arguments).  If there are "<", "<<", or ">" arguments
X     * then make note of input and output redirection and remove these
X     * arguments and the arguments that follow them.
X     */
X
X    cmdCount = 1;
X    lastBar = -1;
X    for (i = 0; i < argc; i++) {
X    if ((argv[i][0] == '|') && ((argv[i][1] == 0))) {
X        if ((i == (lastBar+1)) || (i == (argc-1))) {
X        interp->result = "illegal use of | in command";
X        return -1;
X        }
X        lastBar = i;
X        cmdCount++;
X        continue;
X    } else if (argv[i][0] == '<') {
X        if (argv[i][1] == 0) {
X        input = argv[i+1];
X        inputFile = 1;
X        } else if ((argv[i][1] == '<') && (argv[i][2] == 0)) {
X        input = argv[i+1];
X        inputFile = 0;
X        } else {
X        continue;
X        }
X    } else if ((argv[i][0] == '>') && (argv[i][1] == 0)) {
X        output = argv[i+1];
X    } else {
X        continue;
X    }
X    if (i >= (argc-1)) {
X        Tcl_AppendResult(interp, "can't specify \"", argv[i],
X            "\" as last word in command", (char *) NULL);
X        return -1;
X    }
X    for (j = i+2; j < argc; j++) {
X        argv[j-2] = argv[j];
X    }
X    argc -= 2;
X    i--;            /* Process new arg from same position. */
X    }
X    if (argc == 0) {
X    interp->result =  "didn't specify command to execute";
X    return -1;
X    }
X
X    /*
X     * Set up the redirected input source for the pipeline, if
X     * so requested.
X     */
X
X    if (input != NULL) {
X    if (!inputFile) {
X        /*
X         * Immediate data in command.  Create temporary file and
X         * put data into file.
X         */
X
X#        define TMP_STDIN_NAME "/tmp/tcl.in.XXXXXX"
X        char inName[sizeof(TMP_STDIN_NAME) + 1];
X        int length;
X
X        strcpy(inName, TMP_STDIN_NAME);
X        mktemp(inName);
X        inputId = open(inName, O_RDWR|O_CREAT|O_TRUNC, 0600);
X        if (inputId < 0) {
X        Tcl_AppendResult(interp,
X            "couldn't create input file for command: ",
X            Tcl_UnixError(interp), (char *) NULL);
X        goto error;
X        }
X        length = strlen(input);
X        if (write(inputId, input, length) != length) {
X        Tcl_AppendResult(interp,
X            "couldn't write file input for command: ",
X            Tcl_UnixError(interp), (char *) NULL);
X        goto error;
X        }
X        if ((lseek(inputId, 0L, 0) == -1) || (unlink(inName) == -1)) {
X        Tcl_AppendResult(interp,
X            "couldn't reset or remove input file for command: ",
X            Tcl_UnixError(interp), (char *) NULL);
X        goto error;
X        }
X    } else {
X        /*
X         * File redirection.  Just open the file.
X         */
X
X        inputId = open(input, O_RDONLY, 0);
X        if (inputId < 0) {
X        Tcl_AppendResult(interp,
X            "couldn't read file \"", input, "\": ",
X            Tcl_UnixError(interp), (char *) NULL);
X        goto error;
X        }
X    }
X    } else if (inPipePtr != NULL) {
X    if (pipe(pipeIds) != 0) {
X        Tcl_AppendResult(interp,
X            "couldn't create input pipe for command: ",
X            Tcl_UnixError(interp), (char *) NULL);
X        goto error;
X    }
X    inputId = pipeIds[0];
X    *inPipePtr = pipeIds[1];
X    pipeIds[0] = pipeIds[1] = -1;
X    }
X
X    /*
X     * Set up the redirected output sink for the pipeline from one
X     * of two places, if requested.
X     */
X
X    if (output != NULL) {
X    /*
X     * Output is to go to a file.
X     */
X
X    lastOutputId = open(output, O_WRONLY|O_CREAT|O_TRUNC, 0666);
X    if (lastOutputId < 0) {
X        Tcl_AppendResult(interp,
X            "couldn't write file \"", output, "\": ",
X            Tcl_UnixError(interp), (char *) NULL);
X        goto error;
X    }
X    } else if (outPipePtr != NULL) {
X    /*
X     * Output is to go to a pipe.
X     */
X
X    if (pipe(pipeIds) != 0) {
X        Tcl_AppendResult(interp,
X            "couldn't create output pipe: ",
X            Tcl_UnixError(interp), (char *) NULL);
X        goto error;
X    }
X    lastOutputId = pipeIds[1];
X    *outPipePtr = pipeIds[0];
X    pipeIds[0] = pipeIds[1] = -1;
X    }
X
X    /*
X     * Set up the standard error output sink for the pipeline, if
X     * requested.  Use a temporary file which is opened, then deleted.
X     * Could potentially just use pipe, but if it filled up it could
X     * cause the pipeline to deadlock:  we'd be waiting for processes
X     * to complete before reading stderr, and processes couldn't complete
X     * because stderr was backed up.
X     */
X
X    if (errFilePtr != NULL) {
X#    define TMP_STDERR_NAME "/tmp/tcl.err.XXXXXX"
X    char errName[sizeof(TMP_STDERR_NAME) + 1];
X
X    strcpy(errName, TMP_STDERR_NAME);
X    mktemp(errName);
X    errorId = open(errName, O_WRONLY|O_CREAT|O_TRUNC, 0600);
X    if (errorId < 0) {
X        errFileError:
X        Tcl_AppendResult(interp,
X            "couldn't create error file for command: ",
X            Tcl_UnixError(interp), (char *) NULL);
X        goto error;
X    }
X    *errFilePtr = open(errName, O_RDONLY, 0);
X    if (*errFilePtr < 0) {
X        goto errFileError;
X    }
X    if (unlink(errName) == -1) {
X        Tcl_AppendResult(interp,
X            "couldn't remove error file for command: ",
X            Tcl_UnixError(interp), (char *) NULL);
X        goto error;
X    }
X    }
X
X    /*
X     * Scan through the argc array, forking off a process for each
X     * group of arguments between "|" arguments.
X     */
X
X    pidPtr = (int *) ckalloc((unsigned) (cmdCount * sizeof(int)));
X    for (i = 0; i < numPids; i++) {
X    pidPtr[i] = -1;
X    }
X    for (firstArg = 0; firstArg < argc; numPids++, firstArg = lastArg+1) {
X    for (lastArg = firstArg; lastArg < argc; lastArg++) {
X        if ((argv[lastArg][0] == '|') && (argv[lastArg][1] == 0)) {
X        break;
X        }
X    }
X    argv[lastArg] = NULL;
X    if (lastArg == argc) {
X        outputId = lastOutputId;
X    } else {
X        if (pipe(pipeIds) != 0) {
X        Tcl_AppendResult(interp, "couldn't create pipe: ",
X            Tcl_UnixError(interp), (char *) NULL);
X        goto error;
X        }
X        outputId = pipeIds[1];
X    }
X    execName = Tcl_TildeSubst(interp, argv[firstArg]);
X    pid = Tcl_Fork();
X    if (pid == -1) {
X        Tcl_AppendResult(interp, "couldn't fork child process: ",
X            Tcl_UnixError(interp), (char *) NULL);
X        goto error;
X    }
X    if (pid == 0) {
X        char errSpace[200];
X
X        if (((inputId != -1) && (dup2(inputId, 0) == -1))
X            || ((outputId != -1) && (dup2(outputId, 1) == -1))
X            || ((errorId != -1) && (dup2(errorId, 2) == -1))) {
X        char *err;
X        err = "forked process couldn't set up input/output\n";
X        write(errorId < 0 ? 2 : errorId, err, strlen(err));
X        _exit(1);
X        }
X        for (i = 3; (i <= outputId) || (i <= inputId) || (i <= errorId);
X            i++) {
X        close(i);
X        }
X        execvp(execName, &argv[firstArg]);
X        sprintf(errSpace, "couldn't find \"%.150s\" to execute\n",
X            argv[firstArg]);
X        write(2, errSpace, strlen(errSpace));
X        _exit(1);
X    } else {
X        pidPtr[numPids] = pid;
X    }
X
X    /*
X     * Close off our copies of file descriptors that were set up for
X     * this child, then set up the input for the next child.
X     */
X
X    if (inputId != -1) {
X        close(inputId);
X    }
X    if (outputId != -1) {
X        close(outputId);
X    }
X    inputId = pipeIds[0];
X    pipeIds[0] = pipeIds[1] = -1;
X    }
X    *pidArrayPtr = pidPtr;
X
X    /*
X     * All done.  Cleanup open files lying around and then return.
X     */
X
Xcleanup:
X    if (inputId != -1) {
X    close(inputId);
X    }
X    if (lastOutputId != -1) {
X    close(lastOutputId);
X    }
X    if (errorId != -1) {
X    close(errorId);
X    }
X    return numPids;
X
X    /*
X     * An error occurred.  There could have been extra files open, such
X     * as pipes between children.  Clean them all up.  Detach any child
X     * processes that have been created.
X     */
X
X    error:
X    if ((inPipePtr != NULL) && (*inPipePtr != -1)) {
X    close(*inPipePtr);
X    *inPipePtr = -1;
X    }
X    if ((outPipePtr != NULL) && (*outPipePtr != -1)) {
X    close(*outPipePtr);
X    *outPipePtr = -1;
X    }
X    if ((errFilePtr != NULL) && (*errFilePtr != -1)) {
X    close(*errFilePtr);
X    *errFilePtr = -1;
X    }
X    if (pipeIds[0] != -1) {
X    close(pipeIds[0]);
X    }
X    if (pipeIds[1] != -1) {
X    close(pipeIds[1]);
X    }
X    if (pidPtr != NULL) {
X    for (i = 0; i < numPids; i++) {
X        if (pidPtr[i] != -1) {
X        Tcl_DetachPids(1, &pidPtr[i]);
X        }
X    }
X    ckfree((char *) pidPtr);
X    }
X    numPids = -1;
X    goto cleanup;
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_UnixError --
X *
X *    This procedure is typically called after UNIX kernel calls
X *    return errors.  It stores machine-readable information about
X *    the error in $errorCode returns an information string for
X *    the caller's use.
X *
X * Results:
X *    The return value is a human-readable string describing the
X *    error, as returned by strerror.
X *
X * Side effects:
X *    The global variable $errorCode is reset.
X *
X *----------------------------------------------------------------------
X */
X
Xchar *
XTcl_UnixError(interp)
X    Tcl_Interp *interp;        /* Interpreter whose $errorCode variable
X                 * is to be changed. */
X{
X    char *id, *msg;
X
X    id = Tcl_ErrnoId();
X    msg = strerror(errno);
X    Tcl_SetErrorCode(interp, "UNIX", id, msg, (char *) NULL);
X    return msg;
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * TclMakeFileTable --
X *
X *    Create or enlarge the file table for the interpreter, so that
X *    there is room for a given index.
X *
X * Results:
X *    None.
X *
X * Side effects:
X *    The file table for iPtr will be created if it doesn't exist
X *    (and entries will be added for stdin, stdout, and stderr).
X *    If it already exists, then it will be grown if necessary.
X *
X *----------------------------------------------------------------------
X */
X
Xvoid
XTclMakeFileTable(iPtr, index)
X    Interp *iPtr;        /* Interpreter whose table of files is
X                 * to be manipulated. */
X    int index;            /* Make sure table is large enough to
X                 * hold at least this index. */
X{
X    /*
X     * If the table doesn't even exist, then create it and initialize
X     * entries for standard files.
X     */
X
X    if (iPtr->numFiles == 0) {
X    OpenFile *filePtr;
X    int i;
X
X    if (index < 2) {
X        iPtr->numFiles = 3;
X    } else {
X        iPtr->numFiles = index+1;
X    }
X    iPtr->filePtrArray = (OpenFile **) ckalloc((unsigned)
X        ((iPtr->numFiles)*sizeof(OpenFile *)));
X    for (i = iPtr->numFiles-1; i >= 0; i--) {
X        iPtr->filePtrArray[i] = NULL;
X    }
X
X    filePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
X    filePtr->f = stdin;
X    filePtr->f2 = NULL;
X    filePtr->readable = 1;
X    filePtr->writable = 0;
X    filePtr->numPids = 0;
X    filePtr->pidPtr = NULL;
X    filePtr->errorId = -1;
X    iPtr->filePtrArray[0] = filePtr;
X
X    filePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
X    filePtr->f = stdout;
X    filePtr->f2 = NULL;
X    filePtr->readable = 0;
X    filePtr->writable = 1;
X    filePtr->numPids = 0;
X    filePtr->pidPtr = NULL;
X    filePtr->errorId = -1;
X    iPtr->filePtrArray[1] = filePtr;
X
X    filePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
X    filePtr->f = stderr;
X    filePtr->f2 = NULL;
X    filePtr->readable = 0;
X    filePtr->writable = 1;
X    filePtr->numPids = 0;
X    filePtr->pidPtr = NULL;
X    filePtr->errorId = -1;
X    iPtr->filePtrArray[2] = filePtr;
X    } else if (index >= iPtr->numFiles) {
X    int newSize;
X    OpenFile **newPtrArray;
X    int i;
X
X    newSize = index+1;
X    newPtrArray = (OpenFile **) ckalloc((unsigned)
X        ((newSize)*sizeof(OpenFile *)));
X    memcpy((VOID *) newPtrArray, (VOID *) iPtr->filePtrArray,
X        iPtr->numFiles*sizeof(OpenFile *));
X    for (i = iPtr->numFiles; i < newSize; i++) {
X        newPtrArray[i] = NULL;
X    }
X    ckfree((char *) iPtr->filePtrArray);
X    iPtr->numFiles = newSize;
X    iPtr->filePtrArray = newPtrArray;
X    }
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * TclGetOpenFile --
X *
X *    Given a string identifier for an open file, find the corresponding
X *    open file structure, if there is one.
X *
X * Results:
X *    A standard Tcl return value.  If the open file is successfully
X *    located, *filePtrPtr is modified to point to its structure.
X *    If TCL_ERROR is returned then interp->result contains an error
X *    message.
X *
X * Side effects:
X *    None.
X *
X *----------------------------------------------------------------------
X */
X
Xint
XTclGetOpenFile(interp, string, filePtrPtr)
X    Tcl_Interp *interp;        /* Interpreter in which to find file. */
X    char *string;        /* String that identifies file. */
X    OpenFile **filePtrPtr;    /* Address of word in which to store pointer
X                 * to structure about open file. */
X{
X    int fd = 0;            /* Initial value needed only to stop compiler
X                 * warnings. */
X    Interp *iPtr = (Interp *) interp;
X
X    if ((string[0] == 'f') && (string[1] == 'i') && (string[2] == 'l')
X        & (string[3] == 'e')) {
X    char *end;
X
X    fd = strtoul(string+4, &end, 10);
X    if ((end == string+4) || (*end != 0)) {
X        goto badId;
X    }
X    } else if ((string[0] == 's') && (string[1] == 't')
X        && (string[2] == 'd')) {
X    if (strcmp(string+3, "in") == 0) {
X        fd = 0;
X    } else if (strcmp(string+3, "out") == 0) {
X        fd = 1;
X    } else if (strcmp(string+3, "err") == 0) {
X        fd = 2;
X    } else {
X        goto badId;
X    }
X    } else {
X    badId:
X    Tcl_AppendResult(interp, "bad file identifier \"", string,
X        "\"", (char *) NULL);
X    return TCL_ERROR;
X    }
X
X    if (fd >= iPtr->numFiles) {
X    if ((iPtr->numFiles == 0) && (fd <= 2)) {
X        TclMakeFileTable(iPtr, fd);
X    } else {
X        notOpen:
X        Tcl_AppendResult(interp, "file \"", string, "\" isn't open",
X            (char *) NULL);
X        return TCL_ERROR;
X    }
X    }
X    if (iPtr->filePtrArray[fd] == NULL) {
X    goto notOpen;
X    }
X    *filePtrPtr = iPtr->filePtrArray[fd];
X    return TCL_OK;
X}
END_OF_FILE
if test 28034 -ne `wc -c <'tcl6.1/tclUnixUtil.c'`; then
    echo shar: \"'tcl6.1/tclUnixUtil.c'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tclUnixUtil.c'
fi
echo shar: End of archive 19 \(of 33\).
cp /dev/null ark19isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 ; do
    if test ! -f ark${I}isdone ; then
    MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 33 archives.
    rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
    echo You still need to unpack the following archives:
    echo "        " ${MISSING}
fi
##  End of shell archive.
exit 0

exit 0 # Just in case...
--
Kent Landfield                   INTERNET: [e-mail]
Sterling Software, IMD           UUCP:     uunet!sparky!kent
Phone:    [phone]         FAX:      [phone]
Please send comp.sources.misc-related mail to [e-mail].