This is tclUnixUtil.c in view mode; [Download] [Up]
/*
* tclUnixUtil.c --
*
* This file contains a collection of utility procedures that
* are present in the Tcl's UNIX core but not in the generic
* core. For example, they do file manipulation and process
* manipulation.
*
* The Tcl_Fork and Tcl_WaitPids procedures are based on code
* contributed by Karl Lehenbauer, Mark Diekhans and Peter
* da Silva.
*
* Copyright 1991 Regents of the University of California
* Permission to use, copy, modify, and distribute this
* software and its documentation for any purpose and without
* fee is hereby granted, provided that this copyright
* notice appears in all copies. The University of California
* makes no representations about the suitability of this
* software for any purpose. It is provided "as is" without
* express or implied warranty.
*/
#ifndef lint
static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclUnixUtil.c,v 1.19 93/01/08 08:41:00 ouster Exp $ SPRITE (Berkeley)";
#endif /* not lint */
#include "tclInt.h"
#include "tclUnix.h"
/*
* Data structures of the following type are used by Tcl_Fork and
* Tcl_WaitPids to keep track of child processes.
*/
typedef struct {
int pid; /* Process id of child. */
WAIT_STATUS_TYPE status; /* Status returned when child exited or
* suspended. */
int flags; /* Various flag bits; see below for
* definitions. */
} WaitInfo;
/*
* Flag bits in WaitInfo structures:
*
* WI_READY - Non-zero means process has exited or
* suspended since it was forked or last
* returned by Tcl_WaitPids.
* WI_DETACHED - Non-zero means no-one cares about the
* process anymore. Ignore it until it
* exits, then forget about it.
*/
#define WI_READY 1
#define WI_DETACHED 2
static WaitInfo *waitTable = NULL;
static int waitTableSize = 0; /* Total number of entries available in
* waitTable. */
static int waitTableUsed = 0; /* Number of entries in waitTable that
* are actually in use right now. Active
* entries are always at the beginning
* of the table. */
#define WAIT_TABLE_GROW_BY 4
/*
*----------------------------------------------------------------------
*
* 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 fileId, result;
struct stat statBuf;
char *cmdBuffer, *end, *oldScriptFile;
Interp *iPtr = (Interp *) interp;
oldScriptFile = iPtr->scriptFile;
iPtr->scriptFile = fileName;
fileName = Tcl_TildeSubst(interp, fileName);
if (fileName == NULL) {
goto error;
}
fileId = open(fileName, O_RDONLY, 0);
if (fileId < 0) {
Tcl_AppendResult(interp, "couldn't read file \"", fileName,
"\": ", Tcl_UnixError(interp), (char *) NULL);
goto error;
}
if (fstat(fileId, &statBuf) == -1) {
Tcl_AppendResult(interp, "couldn't stat file \"", fileName,
"\": ", Tcl_UnixError(interp), (char *) NULL);
close(fileId);
goto error;
}
cmdBuffer = (char *) ckalloc((unsigned) statBuf.st_size+1);
if (read(fileId, cmdBuffer, (int) statBuf.st_size) != statBuf.st_size) {
Tcl_AppendResult(interp, "error in reading file \"", fileName,
"\": ", Tcl_UnixError(interp), (char *) NULL);
close(fileId);
ckfree(cmdBuffer);
goto error;
}
if (close(fileId) != 0) {
Tcl_AppendResult(interp, "error closing file \"", fileName,
"\": ", Tcl_UnixError(interp), (char *) NULL);
ckfree(cmdBuffer);
goto error;
}
cmdBuffer[statBuf.st_size] = 0;
result = Tcl_Eval(interp, cmdBuffer, 0, &end);
if (result == TCL_RETURN) {
result = TCL_OK;
}
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);
}
ckfree(cmdBuffer);
iPtr->scriptFile = oldScriptFile;
return result;
error:
iPtr->scriptFile = oldScriptFile;
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
* Tcl_Fork --
*
* Create a new process using the vfork system call, and keep
* track of it for "safe" waiting with Tcl_WaitPids.
*
* Results:
* The return value is the value returned by the vfork system
* call (0 means child, > 0 means parent (value is child id),
* < 0 means error).
*
* Side effects:
* A new process is created, and an entry is added to an internal
* table of child processes if the process is created successfully.
*
*----------------------------------------------------------------------
*/
int
Tcl_Fork()
{
WaitInfo *waitPtr;
pid_t pid;
/*
* Disable SIGPIPE signals: if they were allowed, this process
* might go away unexpectedly if children misbehave. This code
* can potentially interfere with other application code that
* expects to handle SIGPIPEs; what's really needed is an
* arbiter for signals to allow them to be "shared".
*/
if (waitTable == NULL) {
(void) signal(SIGPIPE, SIG_IGN);
}
/*
* Enlarge the wait table if there isn't enough space for a new
* entry.
*/
if (waitTableUsed == waitTableSize) {
int newSize;
WaitInfo *newWaitTable;
newSize = waitTableSize + WAIT_TABLE_GROW_BY;
newWaitTable = (WaitInfo *) ckalloc((unsigned)
(newSize * sizeof(WaitInfo)));
memcpy((VOID *) newWaitTable, (VOID *) waitTable,
(waitTableSize * sizeof(WaitInfo)));
if (waitTable != NULL) {
ckfree((char *) waitTable);
}
waitTable = newWaitTable;
waitTableSize = newSize;
}
/*
* Make a new process and enter it into the table if the fork
* is successful.
*/
waitPtr = &waitTable[waitTableUsed];
pid = fork();
if (pid > 0) {
waitPtr->pid = pid;
waitPtr->flags = 0;
waitTableUsed++;
}
return pid;
}
/*
*----------------------------------------------------------------------
*
* Tcl_WaitPids --
*
* This procedure is used to wait for one or more processes created
* by Tcl_Fork to exit or suspend. It records information about
* all processes that exit or suspend, even those not waited for,
* so that later waits for them will be able to get the status
* information.
*
* Results:
* -1 is returned if there is an error in the wait kernel call.
* Otherwise the pid of an exited/suspended process from *pidPtr
* is returned and *statusPtr is set to the status value returned
* by the wait kernel call.
*
* Side effects:
* Doesn't return until one of the pids at *pidPtr exits or suspends.
*
*----------------------------------------------------------------------
*/
int
Tcl_WaitPids(numPids, pidPtr, statusPtr)
int numPids; /* Number of pids to wait on: gives size
* of array pointed to by pidPtr. */
int *pidPtr; /* Pids to wait on: return when one of
* these processes exits or suspends. */
int *statusPtr; /* Wait status is returned here. */
{
int i, count, pid;
register WaitInfo *waitPtr;
int anyProcesses;
WAIT_STATUS_TYPE status;
while (1) {
/*
* Scan the table of child processes to see if one of the
* specified children has already exited or suspended. If so,
* remove it from the table and return its status.
*/
anyProcesses = 0;
for (waitPtr = waitTable, count = waitTableUsed;
count > 0; waitPtr++, count--) {
for (i = 0; i < numPids; i++) {
if (pidPtr[i] != waitPtr->pid) {
continue;
}
anyProcesses = 1;
if (waitPtr->flags & WI_READY) {
*statusPtr = *((int *) &waitPtr->status);
pid = waitPtr->pid;
if (WIFEXITED(waitPtr->status)
|| WIFSIGNALED(waitPtr->status)) {
*waitPtr = waitTable[waitTableUsed-1];
waitTableUsed--;
} else {
waitPtr->flags &= ~WI_READY;
}
return pid;
}
}
}
/*
* Make sure that the caller at least specified one valid
* process to wait for.
*/
if (!anyProcesses) {
errno = ECHILD;
return -1;
}
/*
* Wait for a process to exit or suspend, then update its
* entry in the table and go back to the beginning of the
* loop to see if it's one of the desired processes.
*/
pid = wait(&status);
if (pid < 0) {
return pid;
}
for (waitPtr = waitTable, count = waitTableUsed; ;
waitPtr++, count--) {
if (count == 0) {
break; /* Ignore unknown processes. */
}
if (pid != waitPtr->pid) {
continue;
}
/*
* If the process has been detached, then ignore anything
* other than an exit, and drop the entry on exit.
*/
if (waitPtr->flags & WI_DETACHED) {
if (WIFEXITED(status) || WIFSIGNALED(status)) {
*waitPtr = waitTable[waitTableUsed-1];
waitTableUsed--;
}
} else {
waitPtr->status = status;
waitPtr->flags |= WI_READY;
}
break;
}
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_DetachPids --
*
* This procedure is called to indicate that one or more child
* processes have been placed in background and are no longer
* cared about. They should be ignored in future calls to
* Tcl_WaitPids.
*
* 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: must have
* been created by Tcl_Fork. */
{
register WaitInfo *waitPtr;
int i, count, pid;
for (i = 0; i < numPids; i++) {
pid = pidPtr[i];
for (waitPtr = waitTable, count = waitTableUsed;
count > 0; waitPtr++, count--) {
if (pid != waitPtr->pid) {
continue;
}
/*
* If the process has already exited then destroy its
* table entry now.
*/
if ((waitPtr->flags & WI_READY) && (WIFEXITED(waitPtr->status)
|| WIFSIGNALED(waitPtr->status))) {
*waitPtr = waitTable[waitTableUsed-1];
waitTableUsed--;
} else {
waitPtr->flags |= WI_DETACHED;
}
goto nextPid;
}
panic("Tcl_Detach couldn't find process");
nextPid:
continue;
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_CreatePipeline --
*
* 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
Tcl_CreatePipeline(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 <,
* <<, and >. 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). */
int *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. -1 means command
* specified its own input source. */
int *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. -1 means command specified
* its own output sink. */
int *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. */
{
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 *input = NULL; /* Describes input for pipeline, depending
* on "inputFile". NULL means take input
* from stdin/pipe. */
int inputFile = 0; /* Non-zero means input is name of input
* file. Zero means input holds actual
* text to be input to command. */
char *output = NULL; /* Holds name of output file to pipe to,
* or NULL if output goes to stdout/pipe. */
int inputId = -1; /* Readable file id input to current command in
* pipeline (could be file or pipe). -1
* means use stdin. */
int outputId = -1; /* Writable file id for output from current
* command in pipeline (could be file or pipe).
* -1 means use stdout. */
int errorId = -1; /* Writable file id for all standard error
* output from all commands in pipeline. -1
* means use stderr. */
int lastOutputId = -1; /* Write file id for output from last command
* in pipeline (could be file or pipe).
* -1 means use stdout. */
int pipeIds[2]; /* File ids for pipe that's being created. */
int firstArg, lastArg; /* Indexes of first and last arguments in
* current command. */
int lastBar;
char *execName;
int i, j, pid;
if (inPipePtr != NULL) {
*inPipePtr = -1;
}
if (outPipePtr != NULL) {
*outPipePtr = -1;
}
if (errFilePtr != NULL) {
*errFilePtr = -1;
}
pipeIds[0] = pipeIds[1] = -1;
/*
* First, scan through all the arguments to figure out the structure
* of the pipeline. Count the number of distinct processes (it's the
* number of "|" arguments). If there are "<", "<<", or ">" arguments
* then make note of input and output redirection and remove these
* arguments and the arguments that follow them.
*/
cmdCount = 1;
lastBar = -1;
for (i = 0; i < argc; i++) {
if ((argv[i][0] == '|') && ((argv[i][1] == 0))) {
if ((i == (lastBar+1)) || (i == (argc-1))) {
interp->result = "illegal use of | in command";
return -1;
}
lastBar = i;
cmdCount++;
continue;
} else if (argv[i][0] == '<') {
if (argv[i][1] == 0) {
input = argv[i+1];
inputFile = 1;
} else if ((argv[i][1] == '<') && (argv[i][2] == 0)) {
input = argv[i+1];
inputFile = 0;
} else {
continue;
}
} else if ((argv[i][0] == '>') && (argv[i][1] == 0)) {
output = argv[i+1];
} else {
continue;
}
if (i >= (argc-1)) {
Tcl_AppendResult(interp, "can't specify \"", argv[i],
"\" as last word in command", (char *) NULL);
return -1;
}
for (j = i+2; j < argc; j++) {
argv[j-2] = argv[j];
}
argc -= 2;
i--; /* Process new arg from same position. */
}
if (argc == 0) {
interp->result = "didn't specify command to execute";
return -1;
}
/*
* Set up the redirected input source for the pipeline, if
* so requested.
*/
if (input != NULL) {
if (!inputFile) {
/*
* Immediate data in command. Create temporary file and
* put data into file.
*/
# define TMP_STDIN_NAME "/tmp/tcl.in.XXXXXX"
char inName[sizeof(TMP_STDIN_NAME) + 1];
int length;
strcpy(inName, TMP_STDIN_NAME);
mktemp(inName);
inputId = open(inName, O_RDWR|O_CREAT|O_TRUNC, 0600);
if (inputId < 0) {
Tcl_AppendResult(interp,
"couldn't create input file for command: ",
Tcl_UnixError(interp), (char *) NULL);
goto error;
}
length = strlen(input);
if (write(inputId, input, length) != length) {
Tcl_AppendResult(interp,
"couldn't write file input for command: ",
Tcl_UnixError(interp), (char *) NULL);
goto error;
}
if ((lseek(inputId, 0L, 0) == -1) || (unlink(inName) == -1)) {
Tcl_AppendResult(interp,
"couldn't reset or remove input file for command: ",
Tcl_UnixError(interp), (char *) NULL);
goto error;
}
} else {
/*
* File redirection. Just open the file.
*/
inputId = open(input, O_RDONLY, 0);
if (inputId < 0) {
Tcl_AppendResult(interp,
"couldn't read file \"", input, "\": ",
Tcl_UnixError(interp), (char *) NULL);
goto error;
}
}
} else if (inPipePtr != NULL) {
if (pipe(pipeIds) != 0) {
Tcl_AppendResult(interp,
"couldn't create input pipe for command: ",
Tcl_UnixError(interp), (char *) NULL);
goto error;
}
inputId = pipeIds[0];
*inPipePtr = pipeIds[1];
pipeIds[0] = pipeIds[1] = -1;
}
/*
* Set up the redirected output sink for the pipeline from one
* of two places, if requested.
*/
if (output != NULL) {
/*
* Output is to go to a file.
*/
lastOutputId = open(output, O_WRONLY|O_CREAT|O_TRUNC, 0666);
if (lastOutputId < 0) {
Tcl_AppendResult(interp,
"couldn't write file \"", output, "\": ",
Tcl_UnixError(interp), (char *) NULL);
goto error;
}
} else if (outPipePtr != NULL) {
/*
* Output is to go to a pipe.
*/
if (pipe(pipeIds) != 0) {
Tcl_AppendResult(interp,
"couldn't create output pipe: ",
Tcl_UnixError(interp), (char *) NULL);
goto error;
}
lastOutputId = pipeIds[1];
*outPipePtr = pipeIds[0];
pipeIds[0] = pipeIds[1] = -1;
}
/*
* 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.
*/
if (errFilePtr != NULL) {
# define TMP_STDERR_NAME "/tmp/tcl.err.XXXXXX"
char errName[sizeof(TMP_STDERR_NAME) + 1];
strcpy(errName, TMP_STDERR_NAME);
mktemp(errName);
errorId = open(errName, O_WRONLY|O_CREAT|O_TRUNC, 0600);
if (errorId < 0) {
errFileError:
Tcl_AppendResult(interp,
"couldn't create error file for command: ",
Tcl_UnixError(interp), (char *) NULL);
goto error;
}
*errFilePtr = open(errName, O_RDONLY, 0);
if (*errFilePtr < 0) {
goto errFileError;
}
if (unlink(errName) == -1) {
Tcl_AppendResult(interp,
"couldn't remove error file for command: ",
Tcl_UnixError(interp), (char *) NULL);
goto error;
}
}
/*
* Scan through the argc array, forking off a process for each
* group of arguments between "|" arguments.
*/
pidPtr = (int *) ckalloc((unsigned) (cmdCount * sizeof(int)));
for (i = 0; i < numPids; i++) {
pidPtr[i] = -1;
}
for (firstArg = 0; firstArg < argc; numPids++, firstArg = lastArg+1) {
for (lastArg = firstArg; lastArg < argc; lastArg++) {
if ((argv[lastArg][0] == '|') && (argv[lastArg][1] == 0)) {
break;
}
}
argv[lastArg] = NULL;
if (lastArg == argc) {
outputId = lastOutputId;
} else {
if (pipe(pipeIds) != 0) {
Tcl_AppendResult(interp, "couldn't create pipe: ",
Tcl_UnixError(interp), (char *) NULL);
goto error;
}
outputId = pipeIds[1];
}
execName = Tcl_TildeSubst(interp, argv[firstArg]);
pid = Tcl_Fork();
if (pid == -1) {
Tcl_AppendResult(interp, "couldn't fork child process: ",
Tcl_UnixError(interp), (char *) NULL);
goto error;
}
if (pid == 0) {
char errSpace[200];
if (((inputId != -1) && (dup2(inputId, 0) == -1))
|| ((outputId != -1) && (dup2(outputId, 1) == -1))
|| ((errorId != -1) && (dup2(errorId, 2) == -1))) {
char *err;
err = "forked process couldn't set up input/output\n";
write(errorId < 0 ? 2 : errorId, err, strlen(err));
_exit(1);
}
for (i = 3; (i <= outputId) || (i <= inputId) || (i <= errorId);
i++) {
close(i);
}
execvp(execName, &argv[firstArg]);
sprintf(errSpace, "couldn't find \"%.150s\" to execute\n",
argv[firstArg]);
write(2, errSpace, strlen(errSpace));
_exit(1);
} else {
pidPtr[numPids] = pid;
}
/*
* Close off our copies of file descriptors that were set up for
* this child, then set up the input for the next child.
*/
if (inputId != -1) {
close(inputId);
}
if (outputId != -1) {
close(outputId);
}
inputId = pipeIds[0];
pipeIds[0] = pipeIds[1] = -1;
}
*pidArrayPtr = pidPtr;
/*
* All done. Cleanup open files lying around and then return.
*/
cleanup:
if (inputId != -1) {
close(inputId);
}
if (lastOutputId != -1) {
close(lastOutputId);
}
if (errorId != -1) {
close(errorId);
}
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 ((inPipePtr != NULL) && (*inPipePtr != -1)) {
close(*inPipePtr);
*inPipePtr = -1;
}
if ((outPipePtr != NULL) && (*outPipePtr != -1)) {
close(*outPipePtr);
*outPipePtr = -1;
}
if ((errFilePtr != NULL) && (*errFilePtr != -1)) {
close(*errFilePtr);
*errFilePtr = -1;
}
if (pipeIds[0] != -1) {
close(pipeIds[0]);
}
if (pipeIds[1] != -1) {
close(pipeIds[1]);
}
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;
}
/*
*----------------------------------------------------------------------
*
* Tcl_UnixError --
*
* 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, as returned by strerror.
*
* Side effects:
* The global variable $errorCode is reset.
*
*----------------------------------------------------------------------
*/
char *
Tcl_UnixError(interp)
Tcl_Interp *interp; /* Interpreter whose $errorCode variable
* is to be changed. */
{
char *id, *msg;
id = Tcl_ErrnoId();
msg = strerror(errno);
Tcl_SetErrorCode(interp, "UNIX", id, msg, (char *) NULL);
return msg;
}
/*
*----------------------------------------------------------------------
*
* TclMakeFileTable --
*
* Create or enlarge the file table for the interpreter, so that
* there is room for a given index.
*
* Results:
* None.
*
* Side effects:
* The file table for iPtr will be created if it doesn't exist
* (and entries will be added for stdin, stdout, and stderr).
* If it already exists, then it will be grown if necessary.
*
*----------------------------------------------------------------------
*/
void
TclMakeFileTable(iPtr, index)
Interp *iPtr; /* Interpreter whose table of files is
* to be manipulated. */
int index; /* Make sure table is large enough to
* hold at least this index. */
{
/*
* If the table doesn't even exist, then create it and initialize
* entries for standard files.
*/
if (iPtr->numFiles == 0) {
OpenFile *filePtr;
int i;
if (index < 2) {
iPtr->numFiles = 3;
} else {
iPtr->numFiles = index+1;
}
iPtr->filePtrArray = (OpenFile **) ckalloc((unsigned)
((iPtr->numFiles)*sizeof(OpenFile *)));
for (i = iPtr->numFiles-1; i >= 0; i--) {
iPtr->filePtrArray[i] = NULL;
}
filePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
filePtr->f = stdin;
filePtr->f2 = NULL;
filePtr->readable = 1;
filePtr->writable = 0;
filePtr->numPids = 0;
filePtr->pidPtr = NULL;
filePtr->errorId = -1;
iPtr->filePtrArray[0] = filePtr;
filePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
filePtr->f = stdout;
filePtr->f2 = NULL;
filePtr->readable = 0;
filePtr->writable = 1;
filePtr->numPids = 0;
filePtr->pidPtr = NULL;
filePtr->errorId = -1;
iPtr->filePtrArray[1] = filePtr;
filePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
filePtr->f = stderr;
filePtr->f2 = NULL;
filePtr->readable = 0;
filePtr->writable = 1;
filePtr->numPids = 0;
filePtr->pidPtr = NULL;
filePtr->errorId = -1;
iPtr->filePtrArray[2] = filePtr;
} else if (index >= iPtr->numFiles) {
int newSize;
OpenFile **newPtrArray;
int i;
newSize = index+1;
newPtrArray = (OpenFile **) ckalloc((unsigned)
((newSize)*sizeof(OpenFile *)));
memcpy((VOID *) newPtrArray, (VOID *) iPtr->filePtrArray,
iPtr->numFiles*sizeof(OpenFile *));
for (i = iPtr->numFiles; i < newSize; i++) {
newPtrArray[i] = NULL;
}
ckfree((char *) iPtr->filePtrArray);
iPtr->numFiles = newSize;
iPtr->filePtrArray = newPtrArray;
}
}
/*
*----------------------------------------------------------------------
*
* TclGetOpenFile --
*
* Given a string identifier for an open file, find the corresponding
* open file structure, if there is one.
*
* Results:
* A standard Tcl return value. If the open file is successfully
* located, *filePtrPtr is modified to point to its structure.
* If TCL_ERROR is returned then interp->result contains an error
* message.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
TclGetOpenFile(interp, string, filePtrPtr)
Tcl_Interp *interp; /* Interpreter in which to find file. */
char *string; /* String that identifies file. */
OpenFile **filePtrPtr; /* Address of word in which to store pointer
* to structure about open file. */
{
int fd = 0; /* Initial value needed only to stop compiler
* warnings. */
Interp *iPtr = (Interp *) interp;
if ((string[0] == 'f') && (string[1] == 'i') && (string[2] == 'l')
& (string[3] == 'e')) {
char *end;
fd = strtoul(string+4, &end, 10);
if ((end == string+4) || (*end != 0)) {
goto badId;
}
} else if ((string[0] == 's') && (string[1] == 't')
&& (string[2] == 'd')) {
if (strcmp(string+3, "in") == 0) {
fd = 0;
} else if (strcmp(string+3, "out") == 0) {
fd = 1;
} else if (strcmp(string+3, "err") == 0) {
fd = 2;
} else {
goto badId;
}
} else {
badId:
Tcl_AppendResult(interp, "bad file identifier \"", string,
"\"", (char *) NULL);
return TCL_ERROR;
}
if (fd >= iPtr->numFiles) {
if ((iPtr->numFiles == 0) && (fd <= 2)) {
TclMakeFileTable(iPtr, fd);
} else {
notOpen:
Tcl_AppendResult(interp, "file \"", string, "\" isn't open",
(char *) NULL);
return TCL_ERROR;
}
}
if (iPtr->filePtrArray[fd] == NULL) {
goto notOpen;
}
*filePtrPtr = iPtr->filePtrArray[fd];
return TCL_OK;
}
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.