summaryrefslogtreecommitdiffstats
path: root/tcl8.6/unix/tclUnixPipe.c
diff options
context:
space:
mode:
authorWilliam Joye <wjoye@cfa.harvard.edu>2017-10-17 19:50:58 (GMT)
committerWilliam Joye <wjoye@cfa.harvard.edu>2017-10-17 19:50:58 (GMT)
commit9b7a6c3507ea3383c60aaecb29f873c9b590ccca (patch)
tree82ce31ebd8f46803d969034f5aa3db8d7974493c /tcl8.6/unix/tclUnixPipe.c
parent87fca7325b97005eb44dcf3e198277640af66115 (diff)
downloadblt-9b7a6c3507ea3383c60aaecb29f873c9b590ccca.zip
blt-9b7a6c3507ea3383c60aaecb29f873c9b590ccca.tar.gz
blt-9b7a6c3507ea3383c60aaecb29f873c9b590ccca.tar.bz2
rm tcl/tk 8.6.7
Diffstat (limited to 'tcl8.6/unix/tclUnixPipe.c')
-rw-r--r--tcl8.6/unix/tclUnixPipe.c1327
1 files changed, 0 insertions, 1327 deletions
diff --git a/tcl8.6/unix/tclUnixPipe.c b/tcl8.6/unix/tclUnixPipe.c
deleted file mode 100644
index 8b26694..0000000
--- a/tcl8.6/unix/tclUnixPipe.c
+++ /dev/null
@@ -1,1327 +0,0 @@
-/*
- * tclUnixPipe.c --
- *
- * This file implements the UNIX-specific exec pipeline functions, the
- * "pipe" channel driver, and the "pid" Tcl command.
- *
- * Copyright (c) 1991-1994 The Regents of the University of California.
- * Copyright (c) 1994-1997 Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution of
- * this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-
-#include "tclInt.h"
-
-#ifdef USE_VFORK
-#define fork vfork
-#endif
-
-/*
- * The following macros convert between TclFile's and fd's. The conversion
- * simple involves shifting fd's up by one to ensure that no valid fd is ever
- * the same as NULL.
- */
-
-#define MakeFile(fd) ((TclFile) INT2PTR(((int) (fd)) + 1))
-#define GetFd(file) (PTR2INT(file) - 1)
-
-/*
- * This structure describes per-instance state of a pipe based channel.
- */
-
-typedef struct PipeState {
- Tcl_Channel channel; /* Channel associated with this file. */
- TclFile inFile; /* Output from pipe. */
- TclFile outFile; /* Input to pipe. */
- TclFile errorFile; /* Error output from pipe. */
- int numPids; /* How many processes are attached to this
- * pipe? */
- Tcl_Pid *pidPtr; /* The process IDs themselves. Allocated by
- * the creator of the pipe. */
- int isNonBlocking; /* Nonzero when the pipe is in nonblocking
- * mode. Used to decide whether to wait for
- * the children at close time. */
-} PipeState;
-
-/*
- * Declarations for local functions defined in this file:
- */
-
-static int PipeBlockModeProc(ClientData instanceData, int mode);
-static int PipeClose2Proc(ClientData instanceData,
- Tcl_Interp *interp, int flags);
-static int PipeGetHandleProc(ClientData instanceData,
- int direction, ClientData *handlePtr);
-static int PipeInputProc(ClientData instanceData, char *buf,
- int toRead, int *errorCode);
-static int PipeOutputProc(ClientData instanceData,
- const char *buf, int toWrite, int *errorCode);
-static void PipeWatchProc(ClientData instanceData, int mask);
-static void RestoreSignals(void);
-static int SetupStdFile(TclFile file, int type);
-
-/*
- * This structure describes the channel type structure for command pipe based
- * I/O:
- */
-
-static const Tcl_ChannelType pipeChannelType = {
- "pipe", /* Type name. */
- TCL_CHANNEL_VERSION_5, /* v5 channel */
- TCL_CLOSE2PROC, /* Close proc. */
- PipeInputProc, /* Input proc. */
- PipeOutputProc, /* Output proc. */
- NULL, /* Seek proc. */
- NULL, /* Set option proc. */
- NULL, /* Get option proc. */
- PipeWatchProc, /* Initialize notifier. */
- PipeGetHandleProc, /* Get OS handles out of channel. */
- PipeClose2Proc, /* close2proc. */
- PipeBlockModeProc, /* Set blocking or non-blocking mode.*/
- NULL, /* flush proc. */
- NULL, /* handler proc. */
- NULL, /* wide seek proc */
- NULL, /* thread action proc */
- NULL /* truncation */
-};
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpMakeFile --
- *
- * Make a TclFile from a channel.
- *
- * Results:
- * Returns a new TclFile or NULL on failure.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-TclFile
-TclpMakeFile(
- Tcl_Channel channel, /* Channel to get file from. */
- int direction) /* Either TCL_READABLE or TCL_WRITABLE. */
-{
- ClientData data;
-
- if (Tcl_GetChannelHandle(channel, direction, &data) != TCL_OK) {
- return NULL;
- }
-
- return MakeFile(PTR2INT(data));
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpOpenFile --
- *
- * Open a file for use in a pipeline.
- *
- * Results:
- * Returns a new TclFile handle or NULL on failure.
- *
- * Side effects:
- * May cause a file to be created on the file system.
- *
- *----------------------------------------------------------------------
- */
-
-TclFile
-TclpOpenFile(
- const char *fname, /* The name of the file to open. */
- int mode) /* In what mode to open the file? */
-{
- int fd;
- const char *native;
- Tcl_DString ds;
-
- native = Tcl_UtfToExternalDString(NULL, fname, -1, &ds);
- fd = TclOSopen(native, mode, 0666); /* INTL: Native. */
- Tcl_DStringFree(&ds);
- if (fd != -1) {
- fcntl(fd, F_SETFD, FD_CLOEXEC);
-
- /*
- * If the file is being opened for writing, seek to the end so we can
- * append to any data already in the file.
- */
-
- if ((mode & O_WRONLY) && !(mode & O_APPEND)) {
- TclOSseek(fd, (Tcl_SeekOffset) 0, SEEK_END);
- }
-
- /*
- * Increment the fd so it can't be 0, which would conflict with the
- * NULL return for errors.
- */
-
- return MakeFile(fd);
- }
- return NULL;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpCreateTempFile --
- *
- * This function creates a temporary file initialized with an optional
- * string, and returns a file handle with the file pointer at the
- * beginning of the file.
- *
- * Results:
- * A handle to a file.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-TclFile
-TclpCreateTempFile(
- const char *contents) /* String to write into temp file, or NULL. */
-{
- int fd = TclUnixOpenTemporaryFile(NULL, NULL, NULL, NULL);
-
- if (fd == -1) {
- return NULL;
- }
- fcntl(fd, F_SETFD, FD_CLOEXEC);
- if (contents != NULL) {
- Tcl_DString dstring;
- char *native;
-
- native = Tcl_UtfToExternalDString(NULL, contents, -1, &dstring);
- if (write(fd, native, Tcl_DStringLength(&dstring)) == -1) {
- close(fd);
- Tcl_DStringFree(&dstring);
- return NULL;
- }
- Tcl_DStringFree(&dstring);
- TclOSseek(fd, (Tcl_SeekOffset) 0, SEEK_SET);
- }
- return MakeFile(fd);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpTempFileName --
- *
- * This function returns unique filename.
- *
- * Results:
- * Returns a valid Tcl_Obj* with refCount 0, or NULL on failure.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclpTempFileName(void)
-{
- Tcl_Obj *retVal, *nameObj = Tcl_NewObj();
- int fd;
-
- Tcl_IncrRefCount(nameObj);
- fd = TclUnixOpenTemporaryFile(NULL, NULL, NULL, nameObj);
- if (fd == -1) {
- Tcl_DecrRefCount(nameObj);
- return NULL;
- }
-
- fcntl(fd, F_SETFD, FD_CLOEXEC);
- TclpObjDeleteFile(nameObj);
- close(fd);
- retVal = Tcl_DuplicateObj(nameObj);
- Tcl_DecrRefCount(nameObj);
- return retVal;
-}
-
-/*
- *----------------------------------------------------------------------------
- *
- * TclpTempFileNameForLibrary --
- *
- * Constructs a file name in the native file system where a dynamically
- * loaded library may be placed.
- *
- * Results:
- * Returns the constructed file name. If an error occurs, returns NULL
- * and leaves an error message in the interpreter result.
- *
- * On Unix, it works to load a shared object from a file of any name, so this
- * function is merely a thin wrapper around TclpTempFileName().
- *
- *----------------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclpTempFileNameForLibrary(
- Tcl_Interp *interp, /* Tcl interpreter. */
- Tcl_Obj *path) /* Path name of the library in the VFS. */
-{
- Tcl_Obj *retval = TclpTempFileName();
-
- if (retval == NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't create temporary file: %s",
- Tcl_PosixError(interp)));
- }
- return retval;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpCreatePipe --
- *
- * Creates a pipe - simply calls the pipe() function.
- *
- * Results:
- * Returns 1 on success, 0 on failure.
- *
- * Side effects:
- * Creates a pipe.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclpCreatePipe(
- TclFile *readPipe, /* Location to store file handle for read side
- * of pipe. */
- TclFile *writePipe) /* Location to store file handle for write
- * side of pipe. */
-{
- int pipeIds[2];
-
- if (pipe(pipeIds) != 0) {
- return 0;
- }
-
- fcntl(pipeIds[0], F_SETFD, FD_CLOEXEC);
- fcntl(pipeIds[1], F_SETFD, FD_CLOEXEC);
-
- *readPipe = MakeFile(pipeIds[0]);
- *writePipe = MakeFile(pipeIds[1]);
- return 1;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpCloseFile --
- *
- * Implements a mechanism to close a UNIX file.
- *
- * Results:
- * Returns 0 on success, or -1 on error, setting errno.
- *
- * Side effects:
- * The file is closed.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclpCloseFile(
- TclFile file) /* The file to close. */
-{
- int fd = GetFd(file);
-
- /*
- * Refuse to close the fds for stdin, stdout and stderr.
- */
-
- if ((fd == 0) || (fd == 1) || (fd == 2)) {
- return 0;
- }
-
- Tcl_DeleteFileHandler(fd);
- return close(fd);
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclpCreateProcess --
- *
- * Create a child process that has the specified files as its standard
- * input, output, and error. The child process runs asynchronously and
- * runs with the same environment variables as the creating process.
- *
- * The path is searched to find the specified executable.
- *
- * Results:
- * The return value is TCL_ERROR and an error message is left in the
- * interp's result if there was a problem creating the child process.
- * Otherwise, the return value is TCL_OK and *pidPtr is filled with the
- * process id of the child process.
- *
- * Side effects:
- * A process is created.
- *
- *---------------------------------------------------------------------------
- */
-
- /* ARGSUSED */
-int
-TclpCreateProcess(
- Tcl_Interp *interp, /* Interpreter in which to leave errors that
- * occurred when creating the child process.
- * Error messages from the child process
- * itself are sent to errorFile. */
- int argc, /* Number of arguments in following array. */
- const char **argv, /* Array of argument strings in UTF-8.
- * argv[0] contains the name of the executable
- * translated using Tcl_TranslateFileName
- * call). Additional arguments have not been
- * converted. */
- TclFile inputFile, /* If non-NULL, gives the file to use as input
- * for the child process. If inputFile file is
- * not readable or is NULL, the child will
- * receive no standard input. */
- TclFile outputFile, /* If non-NULL, gives the file that receives
- * output from the child process. If
- * outputFile file is not writeable or is
- * NULL, output from the child will be
- * discarded. */
- TclFile errorFile, /* If non-NULL, gives the file that receives
- * errors from the child process. If errorFile
- * file is not writeable or is NULL, errors
- * from the child will be discarded. errorFile
- * may be the same as outputFile. */
- Tcl_Pid *pidPtr) /* If this function is successful, pidPtr is
- * filled with the process id of the child
- * process. */
-{
- TclFile errPipeIn, errPipeOut;
- int count, status, fd;
- char errSpace[200 + TCL_INTEGER_SPACE];
- Tcl_DString *dsArray;
- char **newArgv;
- int pid, i;
-
- errPipeIn = NULL;
- errPipeOut = NULL;
- pid = -1;
-
- /*
- * Create a pipe that the child can use to return error information if
- * anything goes wrong.
- */
-
- if (TclpCreatePipe(&errPipeIn, &errPipeOut) == 0) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't create pipe: %s", Tcl_PosixError(interp)));
- goto error;
- }
-
- /*
- * We need to allocate and convert this before the fork so it is properly
- * deallocated later
- */
-
- dsArray = TclStackAlloc(interp, argc * sizeof(Tcl_DString));
- newArgv = TclStackAlloc(interp, (argc+1) * sizeof(char *));
- newArgv[argc] = NULL;
- for (i = 0; i < argc; i++) {
- newArgv[i] = Tcl_UtfToExternalDString(NULL, argv[i], -1, &dsArray[i]);
- }
-
-#ifdef USE_VFORK
- /*
- * After vfork(), do not call code in the child that changes global state,
- * because it is using the parent's memory space at that point and writes
- * might corrupt the parent: so ensure standard channels are initialized
- * in the parent, otherwise SetupStdFile() might initialize them in the
- * child.
- */
-
- if (!inputFile) {
- Tcl_GetStdChannel(TCL_STDIN);
- }
- if (!outputFile) {
- Tcl_GetStdChannel(TCL_STDOUT);
- }
- if (!errorFile) {
- Tcl_GetStdChannel(TCL_STDERR);
- }
-#endif
-
- pid = fork();
- if (pid == 0) {
- size_t len;
- int joinThisError = errorFile && (errorFile == outputFile);
-
- fd = GetFd(errPipeOut);
-
- /*
- * Set up stdio file handles for the child process.
- */
-
- if (!SetupStdFile(inputFile, TCL_STDIN)
- || !SetupStdFile(outputFile, TCL_STDOUT)
- || (!joinThisError && !SetupStdFile(errorFile, TCL_STDERR))
- || (joinThisError &&
- ((dup2(1,2) == -1) || (fcntl(2, F_SETFD, 0) != 0)))) {
- sprintf(errSpace,
- "%dforked process couldn't set up input/output", errno);
- len = strlen(errSpace);
- if (len != (size_t) write(fd, errSpace, len)) {
- Tcl_Panic("TclpCreateProcess: unable to write to errPipeOut");
- }
- _exit(1);
- }
-
- /*
- * Close the input side of the error pipe.
- */
-
- RestoreSignals();
- execvp(newArgv[0], newArgv); /* INTL: Native. */
- sprintf(errSpace, "%dcouldn't execute \"%.150s\"", errno, argv[0]);
- len = strlen(errSpace);
- if (len != (size_t) write(fd, errSpace, len)) {
- Tcl_Panic("TclpCreateProcess: unable to write to errPipeOut");
- }
- _exit(1);
- }
-
- /*
- * Free the mem we used for the fork
- */
-
- for (i = 0; i < argc; i++) {
- Tcl_DStringFree(&dsArray[i]);
- }
- TclStackFree(interp, newArgv);
- TclStackFree(interp, dsArray);
-
- if (pid == -1) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't fork child process: %s", Tcl_PosixError(interp)));
- goto error;
- }
-
- /*
- * Read back from the error pipe to see if the child started up OK. The
- * info in the pipe (if any) consists of a decimal errno value followed by
- * an error message.
- */
-
- TclpCloseFile(errPipeOut);
- errPipeOut = NULL;
-
- fd = GetFd(errPipeIn);
- count = read(fd, errSpace, (size_t) (sizeof(errSpace) - 1));
- if (count > 0) {
- char *end;
-
- errSpace[count] = 0;
- errno = strtol(errSpace, &end, 10);
- Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s: %s",
- end, Tcl_PosixError(interp)));
- goto error;
- }
-
- TclpCloseFile(errPipeIn);
- *pidPtr = (Tcl_Pid) INT2PTR(pid);
- return TCL_OK;
-
- error:
- if (pid != -1) {
- /*
- * Reap the child process now if an error occurred during its startup.
- * We don't call this with WNOHANG because that can lead to defunct
- * processes on an MP system. We shouldn't have to worry about hanging
- * here, since this is the error case. [Bug: 6148]
- */
-
- Tcl_WaitPid((Tcl_Pid) INT2PTR(pid), &status, 0);
- }
-
- if (errPipeIn) {
- TclpCloseFile(errPipeIn);
- }
- if (errPipeOut) {
- TclpCloseFile(errPipeOut);
- }
- return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * RestoreSignals --
- *
- * This function is invoked in a forked child process just before
- * exec-ing a new program to restore all signals to their default
- * settings.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Signal settings get changed.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-RestoreSignals(void)
-{
-#ifdef SIGABRT
- signal(SIGABRT, SIG_DFL);
-#endif
-#ifdef SIGALRM
- signal(SIGALRM, SIG_DFL);
-#endif
-#ifdef SIGFPE
- signal(SIGFPE, SIG_DFL);
-#endif
-#ifdef SIGHUP
- signal(SIGHUP, SIG_DFL);
-#endif
-#ifdef SIGILL
- signal(SIGILL, SIG_DFL);
-#endif
-#ifdef SIGINT
- signal(SIGINT, SIG_DFL);
-#endif
-#ifdef SIGPIPE
- signal(SIGPIPE, SIG_DFL);
-#endif
-#ifdef SIGQUIT
- signal(SIGQUIT, SIG_DFL);
-#endif
-#ifdef SIGSEGV
- signal(SIGSEGV, SIG_DFL);
-#endif
-#ifdef SIGTERM
- signal(SIGTERM, SIG_DFL);
-#endif
-#ifdef SIGUSR1
- signal(SIGUSR1, SIG_DFL);
-#endif
-#ifdef SIGUSR2
- signal(SIGUSR2, SIG_DFL);
-#endif
-#ifdef SIGCHLD
- signal(SIGCHLD, SIG_DFL);
-#endif
-#ifdef SIGCONT
- signal(SIGCONT, SIG_DFL);
-#endif
-#ifdef SIGTSTP
- signal(SIGTSTP, SIG_DFL);
-#endif
-#ifdef SIGTTIN
- signal(SIGTTIN, SIG_DFL);
-#endif
-#ifdef SIGTTOU
- signal(SIGTTOU, SIG_DFL);
-#endif
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SetupStdFile --
- *
- * Set up stdio file handles for the child process, using the current
- * standard channels if no other files are specified. If no standard
- * channel is defined, or if no file is associated with the channel, then
- * the corresponding standard fd is closed.
- *
- * Results:
- * Returns 1 on success, or 0 on failure.
- *
- * Side effects:
- * Replaces stdio fds.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-SetupStdFile(
- TclFile file, /* File to dup, or NULL. */
- int type) /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR */
-{
- Tcl_Channel channel;
- int fd;
- int targetFd = 0; /* Initializations here needed only to */
- int direction = 0; /* prevent warnings about using uninitialized
- * variables. */
-
- switch (type) {
- case TCL_STDIN:
- targetFd = 0;
- direction = TCL_READABLE;
- break;
- case TCL_STDOUT:
- targetFd = 1;
- direction = TCL_WRITABLE;
- break;
- case TCL_STDERR:
- targetFd = 2;
- direction = TCL_WRITABLE;
- break;
- }
-
- if (!file) {
- channel = Tcl_GetStdChannel(type);
- if (channel) {
- file = TclpMakeFile(channel, direction);
- }
- }
- if (file) {
- fd = GetFd(file);
- if (fd != targetFd) {
- if (dup2(fd, targetFd) == -1) {
- return 0;
- }
-
- /*
- * Must clear the close-on-exec flag for the target FD, since some
- * systems (e.g. Ultrix) do not clear the CLOEXEC flag on the
- * target FD.
- */
-
- fcntl(targetFd, F_SETFD, 0);
- } else {
- /*
- * Since we aren't dup'ing the file, we need to explicitly clear
- * the close-on-exec flag.
- */
-
- fcntl(fd, F_SETFD, 0);
- }
- } else {
- close(targetFd);
- }
- return 1;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpCreateCommandChannel --
- *
- * This function is called by the generic IO level to perform the
- * platform specific channel initialization for a command channel.
- *
- * Results:
- * Returns a new channel or NULL on failure.
- *
- * Side effects:
- * Allocates a new channel.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Channel
-TclpCreateCommandChannel(
- TclFile readFile, /* If non-null, gives the file for reading. */
- TclFile writeFile, /* If non-null, gives the file for writing. */
- TclFile errorFile, /* If non-null, gives the file where errors
- * can be read. */
- int numPids, /* The number of pids in the pid array. */
- Tcl_Pid *pidPtr) /* An array of process identifiers. Allocated
- * by the caller, freed when the channel is
- * closed or the processes are detached (in a
- * background exec). */
-{
- char channelName[16 + TCL_INTEGER_SPACE];
- int channelId;
- PipeState *statePtr = ckalloc(sizeof(PipeState));
- int mode;
-
- statePtr->inFile = readFile;
- statePtr->outFile = writeFile;
- statePtr->errorFile = errorFile;
- statePtr->numPids = numPids;
- statePtr->pidPtr = pidPtr;
- statePtr->isNonBlocking = 0;
-
- mode = 0;
- if (readFile) {
- mode |= TCL_READABLE;
- }
- if (writeFile) {
- mode |= TCL_WRITABLE;
- }
-
- /*
- * Use one of the fds associated with the channel as the channel id.
- */
-
- if (readFile) {
- channelId = GetFd(readFile);
- } else if (writeFile) {
- channelId = GetFd(writeFile);
- } else if (errorFile) {
- channelId = GetFd(errorFile);
- } else {
- channelId = 0;
- }
-
- /*
- * For backward compatibility with previous versions of Tcl, we use
- * "file%d" as the base name for pipes even though it would be more
- * natural to use "pipe%d".
- */
-
- sprintf(channelName, "file%d", channelId);
- statePtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName,
- statePtr, mode);
- return statePtr->channel;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_CreatePipe --
- *
- * System dependent interface to create a pipe for the [chan pipe]
- * command. Stolen from TclX.
- *
- * Results:
- * TCL_OK or TCL_ERROR.
- *
- * Side effects:
- * Registers two channels.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_CreatePipe(
- Tcl_Interp *interp, /* Errors returned in result. */
- Tcl_Channel *rchan, /* Returned read side. */
- Tcl_Channel *wchan, /* Returned write side. */
- int flags) /* Reserved for future use. */
-{
- int fileNums[2];
-
- if (pipe(fileNums) < 0) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf("pipe creation failed: %s",
- Tcl_PosixError(interp)));
- return TCL_ERROR;
- }
-
- fcntl(fileNums[0], F_SETFD, FD_CLOEXEC);
- fcntl(fileNums[1], F_SETFD, FD_CLOEXEC);
-
- *rchan = Tcl_MakeFileChannel(INT2PTR(fileNums[0]), TCL_READABLE);
- Tcl_RegisterChannel(interp, *rchan);
- *wchan = Tcl_MakeFileChannel(INT2PTR(fileNums[1]), TCL_WRITABLE);
- Tcl_RegisterChannel(interp, *wchan);
-
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclGetAndDetachPids --
- *
- * This function is invoked in the generic implementation of a
- * background "exec" (an exec when invoked with a terminating "&") to
- * store a list of the PIDs for processes in a command pipeline in the
- * interp's result and to detach the processes.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Modifies the interp's result. Detaches processes.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclGetAndDetachPids(
- Tcl_Interp *interp, /* Interpreter to append the PIDs to. */
- Tcl_Channel chan) /* Handle for the pipeline. */
-{
- PipeState *pipePtr;
- const Tcl_ChannelType *chanTypePtr;
- Tcl_Obj *pidsObj;
- int i;
-
- /*
- * Punt if the channel is not a command channel.
- */
-
- chanTypePtr = Tcl_GetChannelType(chan);
- if (chanTypePtr != &pipeChannelType) {
- return;
- }
-
- pipePtr = Tcl_GetChannelInstanceData(chan);
- TclNewObj(pidsObj);
- for (i = 0; i < pipePtr->numPids; i++) {
- Tcl_ListObjAppendElement(NULL, pidsObj, Tcl_NewIntObj(
- PTR2INT(pipePtr->pidPtr[i])));
- Tcl_DetachPids(1, &pipePtr->pidPtr[i]);
- }
- Tcl_SetObjResult(interp, pidsObj);
- if (pipePtr->numPids > 0) {
- ckfree(pipePtr->pidPtr);
- pipePtr->numPids = 0;
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PipeBlockModeProc --
- *
- * Helper function to set blocking and nonblocking modes on a pipe based
- * channel. Invoked by generic IO level code.
- *
- * Results:
- * 0 if successful, errno when failed.
- *
- * Side effects:
- * Sets the device into blocking or non-blocking mode.
- *
- *----------------------------------------------------------------------
- */
-
- /* ARGSUSED */
-static int
-PipeBlockModeProc(
- ClientData instanceData, /* Pipe state. */
- int mode) /* The mode to set. Can be one of
- * TCL_MODE_BLOCKING or
- * TCL_MODE_NONBLOCKING. */
-{
- PipeState *psPtr = instanceData;
-
- if (psPtr->inFile
- && TclUnixSetBlockingMode(GetFd(psPtr->inFile), mode) < 0) {
- return errno;
- }
- if (psPtr->outFile
- && TclUnixSetBlockingMode(GetFd(psPtr->outFile), mode) < 0) {
- return errno;
- }
-
- psPtr->isNonBlocking = (mode == TCL_MODE_NONBLOCKING);
-
- return 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PipeClose2Proc
- *
- * This function is invoked by the generic IO level to perform
- * pipeline-type-specific half or full-close.
- *
- * Results:
- * 0 on success, errno otherwise.
- *
- * Side effects:
- * Closes the command pipeline channel.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-PipeClose2Proc(
- ClientData instanceData, /* The pipe to close. */
- Tcl_Interp *interp, /* For error reporting. */
- int flags) /* Flags that indicate which side to close. */
-{
- PipeState *pipePtr = instanceData;
- Tcl_Channel errChan;
- int errorCode, result;
-
- errorCode = 0;
- result = 0;
-
- if (((!flags) || (flags & TCL_CLOSE_READ)) && (pipePtr->inFile != NULL)) {
- if (TclpCloseFile(pipePtr->inFile) < 0) {
- errorCode = errno;
- } else {
- pipePtr->inFile = NULL;
- }
- }
- if (((!flags) || (flags & TCL_CLOSE_WRITE)) && (pipePtr->outFile != NULL)
- && (errorCode == 0)) {
- if (TclpCloseFile(pipePtr->outFile) < 0) {
- errorCode = errno;
- } else {
- pipePtr->outFile = NULL;
- }
- }
-
- /*
- * If half-closing, stop here.
- */
-
- if (flags) {
- return errorCode;
- }
-
- if (pipePtr->isNonBlocking || TclInExit()) {
- /*
- * If the channel is non-blocking or Tcl is being cleaned up, just
- * detach the children PIDs, reap them (important if we are in a
- * dynamic load module), and discard the errorFile.
- */
-
- Tcl_DetachPids(pipePtr->numPids, pipePtr->pidPtr);
- Tcl_ReapDetachedProcs();
-
- if (pipePtr->errorFile) {
- TclpCloseFile(pipePtr->errorFile);
- }
- } else {
- /*
- * Wrap the error file into a channel and give it to the cleanup
- * routine.
- */
-
- if (pipePtr->errorFile) {
- errChan = Tcl_MakeFileChannel(
- INT2PTR(GetFd(pipePtr->errorFile)),
- TCL_READABLE);
- } else {
- errChan = NULL;
- }
- result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr,
- errChan);
- }
-
- if (pipePtr->numPids != 0) {
- ckfree(pipePtr->pidPtr);
- }
- ckfree(pipePtr);
- if (errorCode == 0) {
- return result;
- }
- return errorCode;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PipeInputProc --
- *
- * This function is invoked from the generic IO level to read input from
- * a command pipeline based channel.
- *
- * Results:
- * The number of bytes read is returned or -1 on error. An output
- * argument contains a POSIX error code if an error occurs, or zero.
- *
- * Side effects:
- * Reads input from the input device of the channel.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-PipeInputProc(
- ClientData instanceData, /* Pipe state. */
- char *buf, /* Where to store data read. */
- int toRead, /* How much space is available in the
- * buffer? */
- int *errorCodePtr) /* Where to store error code. */
-{
- PipeState *psPtr = instanceData;
- int bytesRead; /* How many bytes were actually read from the
- * input device? */
-
- *errorCodePtr = 0;
-
- /*
- * Assume there is always enough input available. This will block
- * appropriately, and read will unblock as soon as a short read is
- * possible, if the channel is in blocking mode. If the channel is
- * nonblocking, the read will never block. Some OSes can throw an
- * interrupt error, for which we should immediately retry. [Bug #415131]
- */
-
- do {
- bytesRead = read(GetFd(psPtr->inFile), buf, (size_t) toRead);
- } while ((bytesRead < 0) && (errno == EINTR));
-
- if (bytesRead < 0) {
- *errorCodePtr = errno;
- return -1;
- }
- return bytesRead;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PipeOutputProc--
- *
- * This function is invoked from the generic IO level to write output to
- * a command pipeline based channel.
- *
- * Results:
- * The number of bytes written is returned or -1 on error. An output
- * argument contains a POSIX error code if an error occurred, or zero.
- *
- * Side effects:
- * Writes output on the output device of the channel.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-PipeOutputProc(
- ClientData instanceData, /* Pipe state. */
- const char *buf, /* The data buffer. */
- int toWrite, /* How many bytes to write? */
- int *errorCodePtr) /* Where to store error code. */
-{
- PipeState *psPtr = instanceData;
- int written;
-
- *errorCodePtr = 0;
-
- /*
- * Some OSes can throw an interrupt error, for which we should immediately
- * retry. [Bug #415131]
- */
-
- do {
- written = write(GetFd(psPtr->outFile), buf, (size_t) toWrite);
- } while ((written < 0) && (errno == EINTR));
-
- if (written < 0) {
- *errorCodePtr = errno;
- return -1;
- }
- return written;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PipeWatchProc --
- *
- * Initialize the notifier to watch the fds from this channel.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Sets up the notifier so that a future event on the channel will be
- * seen by Tcl.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-PipeWatchProc(
- ClientData instanceData, /* The pipe state. */
- int mask) /* Events of interest; an OR-ed combination of
- * TCL_READABLE, TCL_WRITABLE and
- * TCL_EXCEPTION. */
-{
- PipeState *psPtr = instanceData;
- int newmask;
-
- if (psPtr->inFile) {
- newmask = mask & (TCL_READABLE | TCL_EXCEPTION);
- if (newmask) {
- Tcl_CreateFileHandler(GetFd(psPtr->inFile), newmask,
- (Tcl_FileProc *) Tcl_NotifyChannel, psPtr->channel);
- } else {
- Tcl_DeleteFileHandler(GetFd(psPtr->inFile));
- }
- }
- if (psPtr->outFile) {
- newmask = mask & (TCL_WRITABLE | TCL_EXCEPTION);
- if (newmask) {
- Tcl_CreateFileHandler(GetFd(psPtr->outFile), newmask,
- (Tcl_FileProc *) Tcl_NotifyChannel, psPtr->channel);
- } else {
- Tcl_DeleteFileHandler(GetFd(psPtr->outFile));
- }
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PipeGetHandleProc --
- *
- * Called from Tcl_GetChannelHandle to retrieve OS handles from inside a
- * command pipeline based channel.
- *
- * Results:
- * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if there is no
- * handle for the specified direction.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-PipeGetHandleProc(
- ClientData instanceData, /* The pipe state. */
- int direction, /* TCL_READABLE or TCL_WRITABLE */
- ClientData *handlePtr) /* Where to store the handle. */
-{
- PipeState *psPtr = instanceData;
-
- if (direction == TCL_READABLE && psPtr->inFile) {
- *handlePtr = INT2PTR(GetFd(psPtr->inFile));
- return TCL_OK;
- }
- if (direction == TCL_WRITABLE && psPtr->outFile) {
- *handlePtr = INT2PTR(GetFd(psPtr->outFile));
- return TCL_OK;
- }
- return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_WaitPid --
- *
- * Implements the waitpid system call on Unix systems.
- *
- * Results:
- * Result of calling waitpid.
- *
- * Side effects:
- * Waits for a process to terminate.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Pid
-Tcl_WaitPid(
- Tcl_Pid pid,
- int *statPtr,
- int options)
-{
- int result;
- pid_t real_pid = (pid_t) PTR2INT(pid);
-
- while (1) {
- result = (int) waitpid(real_pid, statPtr, options);
- if ((result != -1) || (errno != EINTR)) {
- return (Tcl_Pid) INT2PTR(result);
- }
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_PidObjCmd --
- *
- * This function is invoked to process the "pid" Tcl command. See the
- * user documentation for details on what it does.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
- /* ARGSUSED */
-int
-Tcl_PidObjCmd(
- ClientData dummy, /* Not used. */
- Tcl_Interp *interp, /* Current interpreter. */
- int objc, /* Number of arguments. */
- Tcl_Obj *const *objv) /* Argument strings. */
-{
- Tcl_Channel chan;
- PipeState *pipePtr;
- int i;
- Tcl_Obj *resultPtr;
-
- if (objc > 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");
- return TCL_ERROR;
- }
-
- if (objc == 1) {
- Tcl_SetObjResult(interp, Tcl_NewLongObj((long) getpid()));
- } else {
- /*
- * Get the channel and make sure that it refers to a pipe.
- */
-
- chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL);
- if (chan == NULL) {
- return TCL_ERROR;
- }
- if (Tcl_GetChannelType(chan) != &pipeChannelType) {
- return TCL_OK;
- }
-
- /*
- * Extract the process IDs from the pipe structure.
- */
-
- pipePtr = Tcl_GetChannelInstanceData(chan);
- resultPtr = Tcl_NewObj();
- for (i = 0; i < pipePtr->numPids; i++) {
- Tcl_ListObjAppendElement(NULL, resultPtr,
- Tcl_NewIntObj(PTR2INT(TclpGetPid(pipePtr->pidPtr[i]))));
- }
- Tcl_SetObjResult(interp, resultPtr);
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpFinalizePipes --
- *
- * Cleans up the pipe subsystem from Tcl_FinalizeThread
- *
- * Results:
- * None.
- *
- * Notes:
- * This function carries out no operation on Unix.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclpFinalizePipes(void)
-{
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */