/* ARGSUSED */
static int
PipeCloseProc(
ClientData instanceData, /* The pipe to close. */
Tcl_Interp *interp) /* For error reporting. */
{
PipeState *pipePtr;
Tcl_Channel errChan;
int errorCode, result;
errorCode = 0;
result = 0;
pipePtr = (PipeState *) instanceData;
if (pipePtr->inFile) {
if (TclpCloseFile(pipePtr->inFile) < 0) {
errorCode = errno;
}
}
if (pipePtr->outFile) {
if ((TclpCloseFile(pipePtr->outFile) < 0) && (errorCode == 0)) {
errorCode = errno;
}
}
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(
(ClientData) INT2PTR(GetFd(pipePtr->errorFile)), TCL_READABLE);
} else {
errChan = NULL;
}
result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr,
errChan);
}
if (pipePtr->numPids != 0) {
ckfree((char *) pipePtr->pidPtr);
}
ckfree((char *) pipePtr);
if (errorCode == 0) {
return result;
}
return errorCode;
}
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;
}
/* 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_AppendResult(interp, "couldn't create pipe: ",
Tcl_PosixError(interp), NULL);
goto error;
}
/*
* We need to allocate and convert this before the fork so it is properly
* deallocated later
*/
dsArray = (Tcl_DString *)
TclStackAlloc(interp, argc * sizeof(Tcl_DString));
newArgv = (char **) 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) {
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);
(void)write(fd, errSpace, (size_t) strlen(errSpace));
_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]);
(void)write(fd, errSpace, (size_t) strlen(errSpace));
_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_AppendResult(interp, "couldn't fork child process: ",
Tcl_PosixError(interp), NULL);
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_AppendResult(interp, end, Tcl_PosixError(interp), NULL);
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;
}
static int
TestfilehandlerCmd(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
CONST char **argv) /* Argument strings. */
{
Pipe *pipePtr;
int i, mask, timeout;
static int initialized = 0;
char buffer[4000];
TclFile file;
/*
* NOTE: When we make this code work on Windows also, the following
* variable needs to be made Unix-only.
*/
if (!initialized) {
for (i = 0; i < MAX_PIPES; i++) {
testPipes[i].readFile = NULL;
}
initialized = 1;
}
if (argc < 2) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
" option ... \"", NULL);
return TCL_ERROR;
}
pipePtr = NULL;
if (argc >= 3) {
if (Tcl_GetInt(interp, argv[2], &i) != TCL_OK) {
return TCL_ERROR;
}
if (i >= MAX_PIPES) {
Tcl_AppendResult(interp, "bad index ", argv[2], NULL);
return TCL_ERROR;
}
pipePtr = &testPipes[i];
}
if (strcmp(argv[1], "close") == 0) {
for (i = 0; i < MAX_PIPES; i++) {
if (testPipes[i].readFile != NULL) {
TclpCloseFile(testPipes[i].readFile);
testPipes[i].readFile = NULL;
TclpCloseFile(testPipes[i].writeFile);
testPipes[i].writeFile = NULL;
}
}
} else if (strcmp(argv[1], "clear") == 0) {
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"",
argv[0], " clear index\"", NULL);
return TCL_ERROR;
}
pipePtr->readCount = pipePtr->writeCount = 0;
} else if (strcmp(argv[1], "counts") == 0) {
char buf[TCL_INTEGER_SPACE * 2];
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"",
argv[0], " counts index\"", NULL);
return TCL_ERROR;
}
sprintf(buf, "%d %d", pipePtr->readCount, pipePtr->writeCount);
Tcl_SetResult(interp, buf, TCL_VOLATILE);
} else if (strcmp(argv[1], "create") == 0) {
if (argc != 5) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"",
argv[0], " create index readMode writeMode\"", NULL);
return TCL_ERROR;
}
if (pipePtr->readFile == NULL) {
if (!TclpCreatePipe(&pipePtr->readFile, &pipePtr->writeFile)) {
Tcl_AppendResult(interp, "couldn't open pipe: ",
Tcl_PosixError(interp), NULL);
return TCL_ERROR;
}
#ifdef O_NONBLOCK
fcntl(GetFd(pipePtr->readFile), F_SETFL, O_NONBLOCK);
fcntl(GetFd(pipePtr->writeFile), F_SETFL, O_NONBLOCK);
#else
Tcl_SetResult(interp, "can't make pipes non-blocking",
TCL_STATIC);
return TCL_ERROR;
#endif
}
pipePtr->readCount = 0;
pipePtr->writeCount = 0;
if (strcmp(argv[3], "readable") == 0) {
Tcl_CreateFileHandler(GetFd(pipePtr->readFile), TCL_READABLE,
TestFileHandlerProc, (ClientData) pipePtr);
} else if (strcmp(argv[3], "off") == 0) {
Tcl_DeleteFileHandler(GetFd(pipePtr->readFile));
} else if (strcmp(argv[3], "disabled") == 0) {
Tcl_CreateFileHandler(GetFd(pipePtr->readFile), 0,
TestFileHandlerProc, (ClientData) pipePtr);
} else {
Tcl_AppendResult(interp, "bad read mode \"", argv[3], "\"", NULL);
return TCL_ERROR;
}
if (strcmp(argv[4], "writable") == 0) {
Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), TCL_WRITABLE,
TestFileHandlerProc, (ClientData) pipePtr);
} else if (strcmp(argv[4], "off") == 0) {
Tcl_DeleteFileHandler(GetFd(pipePtr->writeFile));
} else if (strcmp(argv[4], "disabled") == 0) {
Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), 0,
TestFileHandlerProc, (ClientData) pipePtr);
} else {
Tcl_AppendResult(interp, "bad read mode \"", argv[4], "\"", NULL);
return TCL_ERROR;
}
} else if (strcmp(argv[1], "empty") == 0) {
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"",
argv[0], " empty index\"", NULL);
return TCL_ERROR;
}
while (read(GetFd(pipePtr->readFile), buffer, 4000) > 0) {
/* Empty loop body. */
}
} else if (strcmp(argv[1], "fill") == 0) {
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"",
argv[0], " fill index\"", NULL);
return TCL_ERROR;
}
memset(buffer, 'a', 4000);
while (write(GetFd(pipePtr->writeFile), buffer, 4000) > 0) {
/* Empty loop body. */
}
} else if (strcmp(argv[1], "fillpartial") == 0) {
char buf[TCL_INTEGER_SPACE];
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"",
argv[0], " fillpartial index\"", NULL);
return TCL_ERROR;
}
memset(buffer, 'b', 10);
TclFormatInt(buf, write(GetFd(pipePtr->writeFile), buffer, 10));
Tcl_SetResult(interp, buf, TCL_VOLATILE);
} else if (strcmp(argv[1], "oneevent") == 0) {
Tcl_DoOneEvent(TCL_FILE_EVENTS|TCL_DONT_WAIT);
} else if (strcmp(argv[1], "wait") == 0) {
if (argc != 5) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"",
argv[0], " wait index readable|writable timeout\"", NULL);
return TCL_ERROR;
}
if (pipePtr->readFile == NULL) {
Tcl_AppendResult(interp, "pipe ", argv[2], " doesn't exist", NULL);
return TCL_ERROR;
}
if (strcmp(argv[3], "readable") == 0) {
mask = TCL_READABLE;
file = pipePtr->readFile;
} else {
mask = TCL_WRITABLE;
file = pipePtr->writeFile;
}
if (Tcl_GetInt(interp, argv[4], &timeout) != TCL_OK) {
return TCL_ERROR;
}
i = TclUnixWaitForFile(GetFd(file), mask, timeout);
if (i & TCL_READABLE) {
Tcl_AppendElement(interp, "readable");
}
if (i & TCL_WRITABLE) {
Tcl_AppendElement(interp, "writable");
}
} else if (strcmp(argv[1], "windowevent") == 0) {
Tcl_DoOneEvent(TCL_WINDOW_EVENTS|TCL_DONT_WAIT);
} else {
Tcl_AppendResult(interp, "bad option \"", argv[1],
"\": must be close, clear, counts, create, empty, fill, "
"fillpartial, oneevent, wait, or windowevent", NULL);
return TCL_ERROR;
}
return TCL_OK;
}
