tcluxutl.c

CMX990 demonstration board (DE9901)

     * 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;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * 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;
}