archie/tcl7.6/generic/tclIOUtil.c
2024-05-27 16:40:40 +02:00

1408 lines
40 KiB
C
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

/*
* tclIOUtil.c --
*
* This file contains a collection of utility procedures that
* are shared by the platform specific IO drivers.
*
* Parts of this file are based on code contributed by Karl
* Lehenbauer, Mark Diekhans and Peter da Silva.
*
* Copyright (c) 1991-1994 The Regents of the University of California.
* Copyright (c) 1994-1996 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* SCCS: @(#) tclIOUtil.c 1.128 96/10/02 12:25:36
*/
#include "tclInt.h"
#include "tclPort.h"
/*
* A linked list of the following structures is used to keep track
* of child processes that have been detached but haven't exited
* yet, so we can make sure that they're properly "reaped" (officially
* waited for) and don't lie around as zombies cluttering the
* system.
*/
typedef struct Detached {
int pid; /* Id of process that's been detached
* but isn't known to have exited. */
struct Detached *nextPtr; /* Next in list of all detached
* processes. */
} Detached;
static Detached *detList = NULL; /* List of all detached proceses. */
/*
* Declarations for local procedures defined in this file:
*/
static Tcl_File FileForRedirect _ANSI_ARGS_((Tcl_Interp *interp,
char *spec, int atOk, char *arg, char *nextArg,
int flags, int *skipPtr, int *closePtr,
Tcl_DString *namePtr));
/*
*----------------------------------------------------------------------
*
* FileForRedirect --
*
* This procedure does much of the work of parsing redirection
* operators. It handles "@" if specified and allowed, and a file
* name, and opens the file if necessary.
*
* Results:
* The return value is the descriptor number for the file. If an
* error occurs then NULL is returned and an error message is left
* in interp->result. Several arguments are side-effected; see
* the argument list below for details.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static Tcl_File
FileForRedirect(interp, spec, atOK, arg, nextArg, flags, skipPtr, closePtr,
namePtr)
Tcl_Interp *interp; /* Intepreter to use for error reporting. */
char *spec; /* Points to character just after
* redirection character. */
char *arg; /* Pointer to entire argument containing
* spec: used for error reporting. */
int atOK; /* Non-zero means that '@' notation can be
* used to specify a channel, zero means that
* it isn't. */
char *nextArg; /* Next argument in argc/argv array, if needed
* for file name or channel name. May be
* NULL. */
int flags; /* Flags to use for opening file or to
* specify mode for channel. */
int *skipPtr; /* Filled with 1 if redirection target was
* in spec, 2 if it was in nextArg. */
int *closePtr; /* Filled with one if the caller should
* close the file when done with it, zero
* otherwise. */
Tcl_DString *namePtr; /* Pointer to an initialized Tcl_DString that
* is filled with the name of the file that
* was opened. Unmodified if spec refers
* to a channel. */
{
int writing = (flags & O_WRONLY);
Tcl_Channel chan;
Tcl_File file;
*skipPtr = 1;
if ((atOK != 0) && (*spec == '@')) {
spec++;
if (*spec == '\0') {
spec = nextArg;
if (spec == NULL) {
goto badLastArg;
}
*skipPtr = 2;
}
chan = Tcl_GetChannel(interp, spec, NULL);
if (chan == (Tcl_Channel) NULL) {
return NULL;
}
file = Tcl_GetChannelFile(chan, writing ? TCL_WRITABLE : TCL_READABLE);
if (file == NULL) {
Tcl_AppendResult(interp, "channel \"", Tcl_GetChannelName(chan),
"\" wasn't opened for ",
((writing) ? "writing" : "reading"), (char *) NULL);
return NULL;
}
if (writing) {
/*
* Be sure to flush output to the file, so that anything
* written by the child appears after stuff we've already
* written.
*/
Tcl_Flush(chan);
}
} else {
char *name;
if (*spec == '\0') {
spec = nextArg;
if (spec == NULL) {
goto badLastArg;
}
*skipPtr = 2;
}
name = Tcl_TranslateFileName(interp, spec, namePtr);
if (name != NULL) {
file = TclOpenFile(name, flags);
} else {
file = NULL;
}
if (file == NULL) {
Tcl_AppendResult(interp, "couldn't ",
((writing) ? "write" : "read"), " file \"", spec, "\": ",
Tcl_PosixError(interp), (char *) NULL);
Tcl_DStringFree(namePtr);
return NULL;
}
*closePtr = 1;
}
return file;
badLastArg:
Tcl_AppendResult(interp, "can't specify \"", arg,
"\" as last word in command", (char *) NULL);
return NULL;
}
/*
*----------------------------------------------------------------------
*
* TclGetOpenMode --
*
* Description:
* Computes a POSIX mode mask for opening a file, from a given string,
* and also sets a flag to indicate whether the caller should seek to
* EOF after opening the file.
*
* Results:
* On success, returns mode to pass to "open". If an error occurs, the
* returns -1 and if interp is not NULL, sets interp->result to an
* error message.
*
* Side effects:
* Sets the integer referenced by seekFlagPtr to 1 to tell the caller
* to seek to EOF after opening the file.
*
* Special note:
* This code is based on a prototype implementation contributed
* by Mark Diekhans.
*
*----------------------------------------------------------------------
*/
int
TclGetOpenMode(interp, string, seekFlagPtr)
Tcl_Interp *interp; /* Interpreter to use for error
* reporting - may be NULL. */
char *string; /* Mode string, e.g. "r+" or
* "RDONLY CREAT". */
int *seekFlagPtr; /* Set this to 1 if the caller
* should seek to EOF during the
* opening of the file. */
{
int mode, modeArgc, c, i, gotRW;
char **modeArgv, *flag;
#define RW_MODES (O_RDONLY|O_WRONLY|O_RDWR)
/*
* Check for the simpler fopen-like access modes (e.g. "r"). They
* are distinguished from the POSIX access modes by the presence
* of a lower-case first letter.
*/
*seekFlagPtr = 0;
mode = 0;
if (islower(UCHAR(string[0]))) {
switch (string[0]) {
case 'r':
mode = O_RDONLY;
break;
case 'w':
mode = O_WRONLY|O_CREAT|O_TRUNC;
break;
case 'a':
mode = O_WRONLY|O_CREAT;
*seekFlagPtr = 1;
break;
default:
error:
if (interp != (Tcl_Interp *) NULL) {
Tcl_AppendResult(interp,
"illegal access mode \"", string, "\"",
(char *) NULL);
}
return -1;
}
if (string[1] == '+') {
mode &= ~(O_RDONLY|O_WRONLY);
mode |= O_RDWR;
if (string[2] != 0) {
goto error;
}
} else if (string[1] != 0) {
goto error;
}
return mode;
}
/*
* The access modes are specified using a list of POSIX modes
* such as O_CREAT.
*
* IMPORTANT NOTE: We rely on Tcl_SplitList working correctly when
* a NULL interpreter is passed in.
*/
if (Tcl_SplitList(interp, string, &modeArgc, &modeArgv) != TCL_OK) {
if (interp != (Tcl_Interp *) NULL) {
Tcl_AddErrorInfo(interp,
"\n while processing open access modes \"");
Tcl_AddErrorInfo(interp, string);
Tcl_AddErrorInfo(interp, "\"");
}
return -1;
}
gotRW = 0;
for (i = 0; i < modeArgc; i++) {
flag = modeArgv[i];
c = flag[0];
if ((c == 'R') && (strcmp(flag, "RDONLY") == 0)) {
mode = (mode & ~RW_MODES) | O_RDONLY;
gotRW = 1;
} else if ((c == 'W') && (strcmp(flag, "WRONLY") == 0)) {
mode = (mode & ~RW_MODES) | O_WRONLY;
gotRW = 1;
} else if ((c == 'R') && (strcmp(flag, "RDWR") == 0)) {
mode = (mode & ~RW_MODES) | O_RDWR;
gotRW = 1;
} else if ((c == 'A') && (strcmp(flag, "APPEND") == 0)) {
mode |= O_APPEND;
*seekFlagPtr = 1;
} else if ((c == 'C') && (strcmp(flag, "CREAT") == 0)) {
mode |= O_CREAT;
} else if ((c == 'E') && (strcmp(flag, "EXCL") == 0)) {
mode |= O_EXCL;
} else if ((c == 'N') && (strcmp(flag, "NOCTTY") == 0)) {
#ifdef O_NOCTTY
mode |= O_NOCTTY;
#else
if (interp != (Tcl_Interp *) NULL) {
Tcl_AppendResult(interp, "access mode \"", flag,
"\" not supported by this system", (char *) NULL);
}
ckfree((char *) modeArgv);
return -1;
#endif
} else if ((c == 'N') && (strcmp(flag, "NONBLOCK") == 0)) {
#if defined(O_NDELAY) || defined(O_NONBLOCK)
# ifdef O_NONBLOCK
mode |= O_NONBLOCK;
# else
mode |= O_NDELAY;
# endif
#else
if (interp != (Tcl_Interp *) NULL) {
Tcl_AppendResult(interp, "access mode \"", flag,
"\" not supported by this system", (char *) NULL);
}
ckfree((char *) modeArgv);
return -1;
#endif
} else if ((c == 'T') && (strcmp(flag, "TRUNC") == 0)) {
mode |= O_TRUNC;
} else {
if (interp != (Tcl_Interp *) NULL) {
Tcl_AppendResult(interp, "invalid access mode \"", flag,
"\": must be RDONLY, WRONLY, RDWR, APPEND, CREAT",
" EXCL, NOCTTY, NONBLOCK, or TRUNC", (char *) NULL);
}
ckfree((char *) modeArgv);
return -1;
}
}
ckfree((char *) modeArgv);
if (!gotRW) {
if (interp != (Tcl_Interp *) NULL) {
Tcl_AppendResult(interp, "access mode must include either",
" RDONLY, WRONLY, or RDWR", (char *) NULL);
}
return -1;
}
return mode;
}
/*
*----------------------------------------------------------------------
*
* Tcl_EvalFile --
*
* Read in a file and process the entire file as one gigantic
* Tcl command.
*
* Results:
* A standard Tcl result, which is either the result of executing
* the file or an error indicating why the file couldn't be read.
*
* Side effects:
* Depends on the commands in the file.
*
*----------------------------------------------------------------------
*/
int
Tcl_EvalFile(interp, fileName)
Tcl_Interp *interp; /* Interpreter in which to process file. */
char *fileName; /* Name of file to process. Tilde-substitution
* will be performed on this name. */
{
int result;
struct stat statBuf;
char *cmdBuffer = (char *) NULL;
char *oldScriptFile = (char *) NULL;
Interp *iPtr = (Interp *) interp;
Tcl_DString buffer;
char *nativeName = (char *) NULL;
Tcl_Channel chan = (Tcl_Channel) NULL;
Tcl_ResetResult(interp);
oldScriptFile = iPtr->scriptFile;
iPtr->scriptFile = fileName;
Tcl_DStringInit(&buffer);
nativeName = Tcl_TranslateFileName(interp, fileName, &buffer);
if (nativeName == NULL) {
goto error;
}
/*
* If Tcl_TranslateFileName didn't already copy the file name, do it
* here. This way we don't depend on fileName staying constant
* throughout the execution of the script (e.g., what if it happens
* to point to a Tcl variable that the script could change?).
*/
if (nativeName != Tcl_DStringValue(&buffer)) {
Tcl_DStringSetLength(&buffer, 0);
Tcl_DStringAppend(&buffer, nativeName, -1);
nativeName = Tcl_DStringValue(&buffer);
}
if (stat(nativeName, &statBuf) == -1) {
Tcl_SetErrno(errno);
Tcl_AppendResult(interp, "couldn't read file \"", fileName,
"\": ", Tcl_PosixError(interp), (char *) NULL);
goto error;
}
chan = Tcl_OpenFileChannel(interp, nativeName, "r", 0644);
if (chan == (Tcl_Channel) NULL) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "couldn't read file \"", fileName,
"\": ", Tcl_PosixError(interp), (char *) NULL);
goto error;
}
cmdBuffer = (char *) ckalloc((unsigned) statBuf.st_size+1);
result = Tcl_Read(chan, cmdBuffer, statBuf.st_size);
if (result < 0) {
Tcl_Close(interp, chan);
Tcl_AppendResult(interp, "couldn't read file \"", fileName,
"\": ", Tcl_PosixError(interp), (char *) NULL);
goto error;
}
cmdBuffer[result] = 0;
if (Tcl_Close(interp, chan) != TCL_OK) {
goto error;
}
result = Tcl_Eval(interp, cmdBuffer);
if (result == TCL_RETURN) {
result = TclUpdateReturnInfo(iPtr);
} else if (result == TCL_ERROR) {
char msg[200];
/*
* Record information telling where the error occurred.
*/
sprintf(msg, "\n (file \"%.150s\" line %d)", fileName,
interp->errorLine);
Tcl_AddErrorInfo(interp, msg);
}
iPtr->scriptFile = oldScriptFile;
ckfree(cmdBuffer);
Tcl_DStringFree(&buffer);
return result;
error:
if (cmdBuffer != (char *) NULL) {
ckfree(cmdBuffer);
}
iPtr->scriptFile = oldScriptFile;
Tcl_DStringFree(&buffer);
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
* Tcl_DetachPids --
*
* This procedure is called to indicate that one or more child
* processes have been placed in background and will never be
* waited for; they should eventually be reaped by
* Tcl_ReapDetachedProcs.
*
* Results:
* None.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
void
Tcl_DetachPids(numPids, pidPtr)
int numPids; /* Number of pids to detach: gives size
* of array pointed to by pidPtr. */
int *pidPtr; /* Array of pids to detach. */
{
register Detached *detPtr;
int i;
for (i = 0; i < numPids; i++) {
detPtr = (Detached *) ckalloc(sizeof(Detached));
detPtr->pid = pidPtr[i];
detPtr->nextPtr = detList;
detList = detPtr;
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_ReapDetachedProcs --
*
* This procedure checks to see if any detached processes have
* exited and, if so, it "reaps" them by officially waiting on
* them. It should be called "occasionally" to make sure that
* all detached processes are eventually reaped.
*
* Results:
* None.
*
* Side effects:
* Processes are waited on, so that they can be reaped by the
* system.
*
*----------------------------------------------------------------------
*/
void
Tcl_ReapDetachedProcs()
{
register Detached *detPtr;
Detached *nextPtr, *prevPtr;
int status;
int pid;
for (detPtr = detList, prevPtr = NULL; detPtr != NULL; ) {
pid = (int) Tcl_WaitPid(detPtr->pid, &status, WNOHANG);
if ((pid == 0) || ((pid == -1) && (errno != ECHILD))) {
prevPtr = detPtr;
detPtr = detPtr->nextPtr;
continue;
}
nextPtr = detPtr->nextPtr;
if (prevPtr == NULL) {
detList = detPtr->nextPtr;
} else {
prevPtr->nextPtr = detPtr->nextPtr;
}
ckfree((char *) detPtr);
detPtr = nextPtr;
}
}
/*
*----------------------------------------------------------------------
*
* TclCleanupChildren --
*
* This is a utility procedure used to wait for child processes
* to exit, record information about abnormal exits, and then
* collect any stderr output generated by them.
*
* Results:
* The return value is a standard Tcl result. If anything at
* weird happened with the child processes, TCL_ERROR is returned
* and a message is left in interp->result.
*
* Side effects:
* If the last character of interp->result is a newline, then it
* is removed unless keepNewline is non-zero. File errorId gets
* closed, and pidPtr is freed back to the storage allocator.
*
*----------------------------------------------------------------------
*/
int
TclCleanupChildren(interp, numPids, pidPtr, errorChan)
Tcl_Interp *interp; /* Used for error messages. */
int numPids; /* Number of entries in pidPtr array. */
int *pidPtr; /* Array of process ids of children. */
Tcl_Channel errorChan; /* Channel for file containing stderr output
* from pipeline. NULL means there isn't any
* stderr output. */
{
int result = TCL_OK;
int i, pid, abnormalExit, anyErrorInfo;
WAIT_STATUS_TYPE waitStatus;
char *msg;
abnormalExit = 0;
for (i = 0; i < numPids; i++) {
pid = (int) Tcl_WaitPid(pidPtr[i], (int *) &waitStatus, 0);
if (pid == -1) {
result = TCL_ERROR;
if (interp != (Tcl_Interp *) NULL) {
msg = Tcl_PosixError(interp);
if (errno == ECHILD) {
/*
* This changeup in message suggested by Mark Diekhans
* to remind people that ECHILD errors can occur on
* some systems if SIGCHLD isn't in its default state.
*/
msg =
"child process lost (is SIGCHLD ignored or trapped?)";
}
Tcl_AppendResult(interp, "error waiting for process to exit: ",
msg, (char *) NULL);
}
continue;
}
/*
* Create error messages for unusual process exits. An
* extra newline gets appended to each error message, but
* it gets removed below (in the same fashion that an
* extra newline in the command's output is removed).
*/
if (!WIFEXITED(waitStatus) || (WEXITSTATUS(waitStatus) != 0)) {
char msg1[20], msg2[20];
result = TCL_ERROR;
sprintf(msg1, "%d", pid);
if (WIFEXITED(waitStatus)) {
if (interp != (Tcl_Interp *) NULL) {
sprintf(msg2, "%d", WEXITSTATUS(waitStatus));
Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2,
(char *) NULL);
}
abnormalExit = 1;
} else if (WIFSIGNALED(waitStatus)) {
if (interp != (Tcl_Interp *) NULL) {
char *p;
p = Tcl_SignalMsg((int) (WTERMSIG(waitStatus)));
Tcl_SetErrorCode(interp, "CHILDKILLED", msg1,
Tcl_SignalId((int) (WTERMSIG(waitStatus))), p,
(char *) NULL);
Tcl_AppendResult(interp, "child killed: ", p, "\n",
(char *) NULL);
}
} else if (WIFSTOPPED(waitStatus)) {
if (interp != (Tcl_Interp *) NULL) {
char *p;
p = Tcl_SignalMsg((int) (WSTOPSIG(waitStatus)));
Tcl_SetErrorCode(interp, "CHILDSUSP", msg1,
Tcl_SignalId((int) (WSTOPSIG(waitStatus))),
p, (char *) NULL);
Tcl_AppendResult(interp, "child suspended: ", p, "\n",
(char *) NULL);
}
} else {
if (interp != (Tcl_Interp *) NULL) {
Tcl_AppendResult(interp,
"child wait status didn't make sense\n",
(char *) NULL);
}
}
}
}
/*
* Read the standard error file. If there's anything there,
* then return an error and add the file's contents to the result
* string.
*/
anyErrorInfo = 0;
if (errorChan != NULL) {
/*
* Make sure we start at the beginning of the file.
*/
Tcl_Seek(errorChan, 0L, SEEK_SET);
if (interp != (Tcl_Interp *) NULL) {
while (1) {
#define BUFFER_SIZE 1000
char buffer[BUFFER_SIZE+1];
int count;
count = Tcl_Read(errorChan, buffer, BUFFER_SIZE);
if (count == 0) {
break;
}
result = TCL_ERROR;
if (count < 0) {
Tcl_AppendResult(interp,
"error reading stderr output file: ",
Tcl_PosixError(interp), (char *) NULL);
break; /* out of the "while (1)" loop. */
}
buffer[count] = 0;
Tcl_AppendResult(interp, buffer, (char *) NULL);
anyErrorInfo = 1;
}
}
Tcl_Close((Tcl_Interp *) NULL, errorChan);
}
/*
* If a child exited abnormally but didn't output any error information
* at all, generate an error message here.
*/
if (abnormalExit && !anyErrorInfo && (interp != (Tcl_Interp *) NULL)) {
Tcl_AppendResult(interp, "child process exited abnormally",
(char *) NULL);
}
return result;
}
/*
*----------------------------------------------------------------------
*
* TclCreatePipeline --
*
* Given an argc/argv array, instantiate a pipeline of processes
* as described by the argv.
*
* Results:
* The return value is a count of the number of new processes
* created, or -1 if an error occurred while creating the pipeline.
* *pidArrayPtr is filled in with the address of a dynamically
* allocated array giving the ids of all of the processes. It
* is up to the caller to free this array when it isn't needed
* anymore. If inPipePtr is non-NULL, *inPipePtr is filled in
* with the file id for the input pipe for the pipeline (if any):
* the caller must eventually close this file. If outPipePtr
* isn't NULL, then *outPipePtr is filled in with the file id
* for the output pipe from the pipeline: the caller must close
* this file. If errFilePtr isn't NULL, then *errFilePtr is filled
* with a file id that may be used to read error output after the
* pipeline completes.
*
* Side effects:
* Processes and pipes are created.
*
*----------------------------------------------------------------------
*/
int
TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
outPipePtr, errFilePtr)
Tcl_Interp *interp; /* Interpreter to use for error reporting. */
int argc; /* Number of entries in argv. */
char **argv; /* Array of strings describing commands in
* pipeline plus I/O redirection with <,
* <<, >, etc. Argv[argc] must be NULL. */
int **pidArrayPtr; /* Word at *pidArrayPtr gets filled in with
* address of array of pids for processes
* in pipeline (first pid is first process
* in pipeline). */
Tcl_File *inPipePtr; /* If non-NULL, input to the pipeline comes
* from a pipe (unless overridden by
* redirection in the command). The file
* id with which to write to this pipe is
* stored at *inPipePtr. NULL means command
* specified its own input source. */
Tcl_File *outPipePtr; /* If non-NULL, output to the pipeline goes
* to a pipe, unless overriden by redirection
* in the command. The file id with which to
* read frome this pipe is stored at
* *outPipePtr. NULL means command specified
* its own output sink. */
Tcl_File *errFilePtr; /* If non-NULL, all stderr output from the
* pipeline will go to a temporary file
* created here, and a descriptor to read
* the file will be left at *errFilePtr.
* The file will be removed already, so
* closing this descriptor will be the end
* of the file. If this is NULL, then
* all stderr output goes to our stderr.
* If the pipeline specifies redirection
* then the file will still be created
* but it will never get any data. */
{
#if defined( MAC_TCL )
Tcl_AppendResult(interp,
"command pipelines not supported on Macintosh OS", NULL);
return -1;
#else /* !MAC_TCL */
int *pidPtr = NULL; /* Points to malloc-ed array holding all
* the pids of child processes. */
int numPids = 0; /* Actual number of processes that exist
* at *pidPtr right now. */
int cmdCount; /* Count of number of distinct commands
* found in argc/argv. */
char *inputLiteral = NULL; /* If non-null, then this points to a
* string containing input data (specified
* via <<) to be piped to the first process
* in the pipeline. */
Tcl_File inputFile = NULL; /* If != NULL, gives file to use as input for
* first process in pipeline (specified via <
* or <@). */
Tcl_DString inputFileName; /* If non-empty, gives name of file that
* corresponds to inputFile. */
int inputClose = 0; /* If non-zero, then inputFile should be
* closed when cleaning up. */
Tcl_File outputFile = NULL; /* Writable file for output from last command
* in pipeline (could be file or pipe). NULL
* means use stdout. */
Tcl_DString outputFileName; /* If non-empty, gives name of file that
* corresponds to outputFile. */
int outputClose = 0; /* If non-zero, then outputFile should be
* closed when cleaning up. */
Tcl_File errorFile = NULL; /* Writable file for error output from all
* commands in pipeline. NULL means use
* stderr. */
Tcl_DString errorFileName; /* If non-empty, gives name of file that
* corresponds to errorFile. */
int errorClose = 0; /* If non-zero, then errorFile should be
* closed when cleaning up. */
char *p;
int skip, lastBar, lastArg, i, j, atOK, flags, errorToOutput;
Tcl_DString execBuffer;
Tcl_File pipeIn;
Tcl_File curInFile, curOutFile, curErrFile;
char *curInFileName, *curOutFileName, *curErrFileName;
Tcl_Channel channel;
if (inPipePtr != NULL) {
*inPipePtr = NULL;
}
if (outPipePtr != NULL) {
*outPipePtr = NULL;
}
if (errFilePtr != NULL) {
*errFilePtr = NULL;
}
Tcl_DStringInit(&inputFileName);
Tcl_DStringInit(&outputFileName);
Tcl_DStringInit(&errorFileName);
Tcl_DStringInit(&execBuffer);
pipeIn = NULL;
curInFile = NULL;
curOutFile = NULL;
curErrFile = NULL;
numPids = 0;
pidPtr = NULL;
/*
* First, scan through all the arguments to figure out the structure
* of the pipeline. Process all of the input and output redirection
* arguments and remove them from the argument list in the pipeline.
* Count the number of distinct processes (it's the number of "|"
* arguments plus one) but don't remove the "|" arguments because
* they'll be used in the second pass to seperate the individual
* child processes. Cannot start the child processes in this pass
* because the redirection symbols may appear anywhere in the
* command line -- e.g., the '<' that specifies the input to the
* entire pipe may appear at the very end of the argument list.
*/
lastBar = -1;
cmdCount = 1;
for (i = 0; i < argc; i++) {
skip = 0;
p = argv[i];
switch (*p++) {
case '|':
if (*p == '&') {
p++;
}
if (*p == '\0') {
if ((i == (lastBar + 1)) || (i == (argc - 1))) {
interp->result = "illegal use of | or |& in command";
goto error;
}
}
lastBar = i;
cmdCount++;
break;
case '<':
if (inputClose != 0) {
inputClose = 0;
Tcl_DStringFree(&inputFileName);
TclCloseFile(inputFile);
}
if (*p == '<') {
inputFile = NULL;
inputLiteral = p + 1;
skip = 1;
if (*inputLiteral == '\0') {
inputLiteral = argv[i + 1];
if (inputLiteral == NULL) {
Tcl_AppendResult(interp, "can't specify \"", argv[i],
"\" as last word in command", (char *) NULL);
goto error;
}
skip = 2;
}
} else {
inputLiteral = NULL;
inputFile = FileForRedirect(interp, p, 1, argv[i],
argv[i + 1], O_RDONLY, &skip, &inputClose,
&inputFileName);
if (inputFile == NULL) {
goto error;
}
}
break;
case '>':
atOK = 1;
flags = O_WRONLY | O_CREAT | O_TRUNC;
errorToOutput = 0;
if (*p == '>') {
p++;
atOK = 0;
flags = O_WRONLY | O_CREAT;
}
if (*p == '&') {
if (errorClose != 0) {
errorClose = 0;
Tcl_DStringFree(&errorFileName);
TclCloseFile(errorFile);
}
errorToOutput = 1;
p++;
}
if (outputClose != 0) {
outputClose = 0;
Tcl_DStringFree(&outputFileName);
TclCloseFile(outputFile);
}
outputFile = FileForRedirect(interp, p, atOK, argv[i],
argv[i + 1], flags, &skip, &outputClose,
&outputFileName);
if (outputFile == NULL) {
goto error;
}
if (atOK == 0) {
TclSeekFile(outputFile, 0, SEEK_END);
}
if (errorToOutput) {
errorClose = 0;
errorFile = outputFile;
}
break;
case '2':
if (*p != '>') {
break;
}
p++;
atOK = 1;
flags = O_WRONLY | O_CREAT | O_TRUNC;
if (*p == '>') {
p++;
atOK = 0;
flags = O_WRONLY | O_CREAT;
}
if (errorClose != 0) {
errorClose = 0;
Tcl_DStringFree(&errorFileName);
TclCloseFile(errorFile);
}
errorFile = FileForRedirect(interp, p, atOK, argv[i],
argv[i + 1], flags, &skip, &errorClose,
&errorFileName);
if (errorFile == NULL) {
goto error;
}
if (atOK == 0) {
TclSeekFile(errorFile, 0, SEEK_END);
}
break;
}
if (skip != 0) {
for (j = i + skip; j < argc; j++) {
argv[j - skip] = argv[j];
}
argc -= skip;
i -= 1;
}
}
if (inputFile == NULL) {
if (inputLiteral != NULL) {
/*
* The input for the first process is immediate data coming from
* Tcl. Create a temporary file for it and put the data into the
* file.
*/
inputFile = TclCreateTempFile(inputLiteral, &inputFileName);
if (inputFile == NULL) {
Tcl_AppendResult(interp,
"couldn't create input file for command: ",
Tcl_PosixError(interp), (char *) NULL);
goto error;
}
inputClose = 1;
} else if (inPipePtr != NULL) {
/*
* The input for the first process in the pipeline is to
* come from a pipe that can be written from by the caller.
*/
if (TclCreatePipe(&inputFile, inPipePtr) == 0) {
Tcl_AppendResult(interp,
"couldn't create input pipe for command: ",
Tcl_PosixError(interp), (char *) NULL);
goto error;
}
inputClose = 1;
} else {
/*
* The input for the first process comes from stdin.
*/
channel = Tcl_GetStdChannel(TCL_STDIN);
if (channel != NULL) {
inputFile = Tcl_GetChannelFile(channel, TCL_READABLE);
}
}
}
if (outputFile == NULL) {
if (outPipePtr != NULL) {
/*
* Output from the last process in the pipeline is to go to a
* pipe that can be read by the caller.
*/
if (TclCreatePipe(outPipePtr, &outputFile) == 0) {
Tcl_AppendResult(interp,
"couldn't create output pipe for command: ",
Tcl_PosixError(interp), (char *) NULL);
goto error;
}
outputClose = 1;
} else {
/*
* The output for the last process goes to stdout.
*/
channel = Tcl_GetStdChannel(TCL_STDOUT);
if (channel) {
outputFile = Tcl_GetChannelFile(channel, TCL_WRITABLE);
}
}
}
if (errorFile == NULL) {
if (errFilePtr != NULL) {
/*
* Set up the standard error output sink for the pipeline, if
* requested. Use a temporary file which is opened, then deleted.
* Could potentially just use pipe, but if it filled up it could
* cause the pipeline to deadlock: we'd be waiting for processes
* to complete before reading stderr, and processes couldn't
* complete because stderr was backed up.
*/
errorFile = TclCreateTempFile(NULL, &errorFileName);
if (errorFile == NULL) {
Tcl_AppendResult(interp,
"couldn't create error file for command: ",
Tcl_PosixError(interp), (char *) NULL);
goto error;
}
*errFilePtr = errorFile;
} else {
/*
* Errors from the pipeline go to stderr.
*/
channel = Tcl_GetStdChannel(TCL_STDERR);
if (channel) {
errorFile = Tcl_GetChannelFile(channel, TCL_WRITABLE);
}
}
}
/*
* Scan through the argc array, creating a process for each
* group of arguments between the "|" characters.
*/
Tcl_ReapDetachedProcs();
pidPtr = (int *) ckalloc((unsigned) (cmdCount * sizeof(int)));
curInFile = inputFile;
curInFileName = Tcl_DStringValue(&inputFileName);
if (curInFileName[0] == '\0') {
curInFileName = NULL;
}
for (i = 0; i < argc; i = lastArg + 1) {
int joinThisError, pid;
/*
* Convert the program name into native form.
*/
argv[i] = Tcl_TranslateFileName(interp, argv[i], &execBuffer);
if (argv[i] == NULL) {
goto error;
}
/*
* Find the end of the current segment of the pipeline.
*/
joinThisError = 0;
for (lastArg = i; lastArg < argc; lastArg++) {
if (argv[lastArg][0] == '|') {
if (argv[lastArg][1] == '\0') {
break;
}
if ((argv[lastArg][1] == '&') && (argv[lastArg][2] == '\0')) {
joinThisError = 1;
break;
}
}
}
argv[lastArg] = NULL;
/*
* If this is the last segment, use the specified outputFile.
* Otherwise create an intermediate pipe. pipeIn will become the
* curInFile for the next segment of the pipe.
*/
if (lastArg == argc) {
curOutFile = outputFile;
curOutFileName = Tcl_DStringValue(&outputFileName);
if (curOutFileName[0] == '\0') {
curOutFileName = NULL;
}
} else {
if (TclCreatePipe(&pipeIn, &curOutFile) == 0) {
Tcl_AppendResult(interp, "couldn't create pipe: ",
Tcl_PosixError(interp), (char *) NULL);
goto error;
}
curOutFileName = NULL;
}
if (joinThisError != 0) {
curErrFile = curOutFile;
curErrFileName = curOutFileName;
} else {
curErrFile = errorFile;
curErrFileName = Tcl_DStringValue(&errorFileName);
if (curErrFileName[0] == '\0') {
curErrFileName = NULL;
}
}
if (TclpCreateProcess(interp, lastArg - i, argv + i,
curInFile, curOutFile, curErrFile, curInFileName,
curOutFileName, curErrFileName, &pid) != TCL_OK) {
goto error;
}
Tcl_DStringFree(&execBuffer);
pidPtr[numPids] = pid;
numPids++;
/*
* Close off our copies of file descriptors that were set up for
* this child, then set up the input for the next child.
*/
if ((curInFile != NULL) && (curInFile != inputFile)) {
TclCloseFile(curInFile);
}
curInFile = pipeIn;
curInFileName = NULL;
pipeIn = NULL;
if ((curOutFile != NULL) && (curOutFile != outputFile)) {
TclCloseFile(curOutFile);
}
curOutFile = NULL;
}
*pidArrayPtr = pidPtr;
/*
* All done. Cleanup open files lying around and then return.
*/
cleanup:
Tcl_DStringFree(&inputFileName);
Tcl_DStringFree(&outputFileName);
Tcl_DStringFree(&errorFileName);
Tcl_DStringFree(&execBuffer);
if (inputClose) {
TclCloseFile(inputFile);
}
if (outputClose) {
TclCloseFile(outputFile);
}
if (errorClose) {
TclCloseFile(errorFile);
}
return numPids;
/*
* An error occurred. There could have been extra files open, such
* as pipes between children. Clean them all up. Detach any child
* processes that have been created.
*/
error:
if (pipeIn != NULL) {
TclCloseFile(pipeIn);
}
if ((curOutFile != NULL) && (curOutFile != outputFile)) {
TclCloseFile(curOutFile);
}
if ((curInFile != NULL) && (curInFile != inputFile)) {
TclCloseFile(curInFile);
}
if ((inPipePtr != NULL) && (*inPipePtr != NULL)) {
TclCloseFile(*inPipePtr);
*inPipePtr = NULL;
}
if ((outPipePtr != NULL) && (*outPipePtr != NULL)) {
TclCloseFile(*outPipePtr);
*outPipePtr = NULL;
}
if ((errFilePtr != NULL) && (*errFilePtr != NULL)) {
TclCloseFile(*errFilePtr);
*errFilePtr = NULL;
}
if (pidPtr != NULL) {
for (i = 0; i < numPids; i++) {
if (pidPtr[i] != -1) {
Tcl_DetachPids(1, &pidPtr[i]);
}
}
ckfree((char *) pidPtr);
}
numPids = -1;
goto cleanup;
#endif /* !MAC_TCL */
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetErrno --
*
* Gets the current value of the Tcl error code variable. This is
* currently the global variable "errno" but could in the future
* change to something else.
*
* Results:
* The value of the Tcl error code variable.
*
* Side effects:
* None. Note that the value of the Tcl error code variable is
* UNDEFINED if a call to Tcl_SetErrno did not precede this call.
*
*----------------------------------------------------------------------
*/
int
Tcl_GetErrno()
{
return errno;
}
/*
*----------------------------------------------------------------------
*
* Tcl_SetErrno --
*
* Sets the Tcl error code variable to the supplied value.
*
* Results:
* None.
*
* Side effects:
* Modifies the value of the Tcl error code variable.
*
*----------------------------------------------------------------------
*/
void
Tcl_SetErrno(err)
int err; /* The new value. */
{
errno = err;
}
/*
*----------------------------------------------------------------------
*
* Tcl_PosixError --
*
* This procedure is typically called after UNIX kernel calls
* return errors. It stores machine-readable information about
* the error in $errorCode returns an information string for
* the caller's use.
*
* Results:
* The return value is a human-readable string describing the
* error.
*
* Side effects:
* The global variable $errorCode is reset.
*
*----------------------------------------------------------------------
*/
char *
Tcl_PosixError(interp)
Tcl_Interp *interp; /* Interpreter whose $errorCode variable
* is to be changed. */
{
char *id, *msg;
msg = Tcl_ErrnoMsg(errno);
id = Tcl_ErrnoId();
Tcl_SetErrorCode(interp, "POSIX", id, msg, (char *) NULL);
return msg;
}
/*
*----------------------------------------------------------------------
*
* Tcl_OpenCommandChannel --
*
* Opens an I/O channel to one or more subprocesses specified
* by argc and argv. The flags argument determines the
* disposition of the stdio handles. If the TCL_STDIN flag is
* set then the standard input for the first subprocess will
* be tied to the channel: writing to the channel will provide
* input to the subprocess. If TCL_STDIN is not set, then
* standard input for the first subprocess will be the same as
* this application's standard input. If TCL_STDOUT is set then
* standard output from the last subprocess can be read from the
* channel; otherwise it goes to this application's standard
* output. If TCL_STDERR is set, standard error output for all
* subprocesses is returned to the channel and results in an error
* when the channel is closed; otherwise it goes to this
* application's standard error. If TCL_ENFORCE_MODE is not set,
* then argc and argv can redirect the stdio handles to override
* TCL_STDIN, TCL_STDOUT, and TCL_STDERR; if it is set, then it
* is an error for argc and argv to override stdio channels for
* which TCL_STDIN, TCL_STDOUT, and TCL_STDERR have been set.
*
* Results:
* A new command channel, or NULL on failure with an error
* message left in interp.
*
* Side effects:
* Creates processes, opens pipes.
*
*----------------------------------------------------------------------
*/
Tcl_Channel
Tcl_OpenCommandChannel(interp, argc, argv, flags)
Tcl_Interp *interp; /* Interpreter for error reporting. Can
* NOT be NULL. */
int argc; /* How many arguments. */
char **argv; /* Array of arguments for command pipe. */
int flags; /* Or'ed combination of TCL_STDIN, TCL_STDOUT,
* TCL_STDERR, and TCL_ENFORCE_MODE. */
{
Tcl_File *inPipePtr, *outPipePtr, *errFilePtr;
Tcl_File inPipe, outPipe, errFile;
int numPids, *pidPtr;
Tcl_Channel channel;
inPipe = outPipe = errFile = NULL;
inPipePtr = (flags & TCL_STDIN) ? &inPipe : NULL;
outPipePtr = (flags & TCL_STDOUT) ? &outPipe : NULL;
errFilePtr = (flags & TCL_STDERR) ? &errFile : NULL;
numPids = TclCreatePipeline(interp, argc, argv, &pidPtr, inPipePtr,
outPipePtr, errFilePtr);
if (numPids < 0) {
goto error;
}
/*
* Verify that the pipes that were created satisfy the
* readable/writable constraints.
*/
if (flags & TCL_ENFORCE_MODE) {
if ((flags & TCL_STDOUT) && (outPipe == NULL)) {
Tcl_AppendResult(interp, "can't read output from command:",
" standard output was redirected", (char *) NULL);
goto error;
}
if ((flags & TCL_STDIN) && (inPipe == NULL)) {
Tcl_AppendResult(interp, "can't write input to command:",
" standard input was redirected", (char *) NULL);
goto error;
}
}
channel = TclCreateCommandChannel(outPipe, inPipe, errFile,
numPids, pidPtr);
if (channel == (Tcl_Channel) NULL) {
Tcl_AppendResult(interp, "pipe for command could not be created",
(char *) NULL);
goto error;
}
return channel;
error:
if (numPids > 0) {
Tcl_DetachPids(numPids, pidPtr);
ckfree((char *) pidPtr);
}
if (inPipe != NULL) {
TclClosePipeFile(inPipe);
}
if (outPipe != NULL) {
TclClosePipeFile(outPipe);
}
if (errFile != NULL) {
TclClosePipeFile(errFile);
}
return NULL;
}