#include "tclInt.h"
#include "tclPort.h"
#include <signal.h>
#include <sys/resource.h>
#define MakeFile(fd) ((TclFile)((fd)+1))
#define GetFd(file) (((int)file)-1)
typedef struct Pipe {
TclFile readFile;
TclFile writeFile;
int readCount;
int writeCount;
} Pipe;
#define MAX_PIPES 10
static Pipe testPipes[MAX_PIPES];
static char *gotsig = "0";
static void TestFileHandlerProc _ANSI_ARGS_((ClientData clientData,
int mask));
static int TestfilehandlerCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, CONST char **argv));
static int TestfilewaitCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, CONST char **argv));
static int TestfindexecutableCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, CONST char **argv));
static int TestgetopenfileCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, CONST char **argv));
static int TestgetdefencdirCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, CONST char **argv));
static int TestsetdefencdirCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, CONST char **argv));
int TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
static int TestalarmCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, CONST char **argv));
static int TestgotsigCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, CONST char **argv));
static void AlarmHandler _ANSI_ARGS_(());
int
TclplatformtestInit(interp)
Tcl_Interp *interp;
{
Tcl_CreateCommand(interp, "testfilehandler", TestfilehandlerCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testfilewait", TestfilewaitCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testfindexecutable", TestfindexecutableCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testgetdefenc", TestgetdefencdirCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testsetdefenc", TestsetdefencdirCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testalarm", TestalarmCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testgotsig", TestgotsigCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
return TCL_OK;
}
static int
TestfilehandlerCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
CONST char **argv;
{
Pipe *pipePtr;
int i, mask, timeout;
static int initialized = 0;
char buffer[4000];
TclFile file;
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 ... \"", (char *) 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], (char *) 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\"", (char *) 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\"", (char *) 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\"",
(char *) NULL);
return TCL_ERROR;
}
if (pipePtr->readFile == NULL) {
if (!TclpCreatePipe(&pipePtr->readFile, &pipePtr->writeFile)) {
Tcl_AppendResult(interp, "couldn't open pipe: ",
Tcl_PosixError(interp), (char *) 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], "\"",
(char *) 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], "\"",
(char *) 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\"", (char *) NULL);
return TCL_ERROR;
}
while (read(GetFd(pipePtr->readFile), buffer, 4000) > 0) {
}
} else if (strcmp(argv[1], "fill") == 0) {
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"",
argv[0], " empty index\"", (char *) NULL);
return TCL_ERROR;
}
memset((VOID *) buffer, 'a', 4000);
while (write(GetFd(pipePtr->writeFile), buffer, 4000) > 0) {
}
} else if (strcmp(argv[1], "fillpartial") == 0) {
char buf[TCL_INTEGER_SPACE];
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"",
argv[0], " empty index\"", (char *) NULL);
return TCL_ERROR;
}
memset((VOID *) 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\"",
(char *) NULL);
return TCL_ERROR;
}
if (pipePtr->readFile == NULL) {
Tcl_AppendResult(interp, "pipe ", argv[2], " doesn't exist",
(char *) 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",
(char *) NULL);
return TCL_ERROR;
}
return TCL_OK;
}
static void TestFileHandlerProc(clientData, mask)
ClientData clientData;
int mask;
{
Pipe *pipePtr = (Pipe *) clientData;
if (mask & TCL_READABLE) {
pipePtr->readCount++;
}
if (mask & TCL_WRITABLE) {
pipePtr->writeCount++;
}
}
static int
TestfilewaitCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
CONST char **argv;
{
int mask, result, timeout;
Tcl_Channel channel;
int fd;
ClientData data;
if (argc != 4) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
" file readable|writable|both timeout\"", (char *) NULL);
return TCL_ERROR;
}
channel = Tcl_GetChannel(interp, argv[1], NULL);
if (channel == NULL) {
return TCL_ERROR;
}
if (strcmp(argv[2], "readable") == 0) {
mask = TCL_READABLE;
} else if (strcmp(argv[2], "writable") == 0){
mask = TCL_WRITABLE;
} else if (strcmp(argv[2], "both") == 0){
mask = TCL_WRITABLE|TCL_READABLE;
} else {
Tcl_AppendResult(interp, "bad argument \"", argv[2],
"\": must be readable, writable, or both", (char *) NULL);
return TCL_ERROR;
}
if (Tcl_GetChannelHandle(channel,
(mask & TCL_READABLE) ? TCL_READABLE : TCL_WRITABLE,
(ClientData*) &data) != TCL_OK) {
Tcl_SetResult(interp, "couldn't get channel file", TCL_STATIC);
return TCL_ERROR;
}
fd = (int) data;
if (Tcl_GetInt(interp, argv[3], &timeout) != TCL_OK) {
return TCL_ERROR;
}
result = TclUnixWaitForFile(fd, mask, timeout);
if (result & TCL_READABLE) {
Tcl_AppendElement(interp, "readable");
}
if (result & TCL_WRITABLE) {
Tcl_AppendElement(interp, "writable");
}
return TCL_OK;
}
static int
TestfindexecutableCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
CONST char **argv;
{
char *oldName;
char *oldNativeName;
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
" argv0\"", (char *) NULL);
return TCL_ERROR;
}
oldName = tclExecutableName;
oldNativeName = tclNativeExecutableName;
tclExecutableName = NULL;
tclNativeExecutableName = NULL;
Tcl_FindExecutable(argv[1]);
if (tclExecutableName != NULL) {
Tcl_SetResult(interp, tclExecutableName, TCL_VOLATILE);
ckfree(tclExecutableName);
}
if (tclNativeExecutableName != NULL) {
ckfree(tclNativeExecutableName);
}
tclExecutableName = oldName;
tclNativeExecutableName = oldNativeName;
return TCL_OK;
}
static int
TestgetopenfileCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
CONST char **argv;
{
ClientData filePtr;
if (argc != 3) {
Tcl_AppendResult(interp,
"wrong # args: should be \"", argv[0],
" channelName forWriting\"",
(char *) NULL);
return TCL_ERROR;
}
if (Tcl_GetOpenFile(interp, argv[1], atoi(argv[2]), 1, &filePtr)
== TCL_ERROR) {
return TCL_ERROR;
}
if (filePtr == (ClientData) NULL) {
Tcl_AppendResult(interp,
"Tcl_GetOpenFile succeeded but FILE * NULL!", (char *) NULL);
return TCL_ERROR;
}
return TCL_OK;
}
static int
TestsetdefencdirCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
CONST char **argv;
{
if (argc != 2) {
Tcl_AppendResult(interp,
"wrong # args: should be \"", argv[0],
" defaultDir\"",
(char *) NULL);
return TCL_ERROR;
}
if (tclDefaultEncodingDir != NULL) {
ckfree(tclDefaultEncodingDir);
tclDefaultEncodingDir = NULL;
}
if (*argv[1] != '\0') {
tclDefaultEncodingDir = (char *)
ckalloc((unsigned) strlen(argv[1]) + 1);
strcpy(tclDefaultEncodingDir, argv[1]);
}
return TCL_OK;
}
static int
TestgetdefencdirCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
CONST char **argv;
{
if (argc != 1) {
Tcl_AppendResult(interp,
"wrong # args: should be \"", argv[0],
(char *) NULL);
return TCL_ERROR;
}
if (tclDefaultEncodingDir != NULL) {
Tcl_AppendResult(interp, tclDefaultEncodingDir, (char *) NULL);
}
return TCL_OK;
}
static int
TestalarmCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
CONST char **argv;
{
#ifdef SA_RESTART
unsigned int sec;
struct sigaction action;
if (argc > 1) {
Tcl_GetInt(interp, argv[1], (int *)&sec);
} else {
sec = 1;
}
action.sa_handler = AlarmHandler;
memset((void *)&action.sa_mask, 0, sizeof(sigset_t));
action.sa_flags = SA_RESTART;
if (sigaction(SIGALRM, &action, NULL) < 0) {
Tcl_AppendResult(interp, "sigaction: ", Tcl_PosixError(interp), NULL);
return TCL_ERROR;
}
if (alarm(sec) < 0) {
Tcl_AppendResult(interp, "alarm: ", Tcl_PosixError(interp), NULL);
return TCL_ERROR;
}
return TCL_OK;
#else
Tcl_AppendResult(interp, "warning: sigaction SA_RESTART not support on this platform", NULL);
return TCL_ERROR;
#endif
}
static void
AlarmHandler()
{
gotsig = "1";
}
static int
TestgotsigCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
CONST char **argv;
{
Tcl_AppendResult(interp, gotsig, (char *) NULL);
gotsig = "0";
return TCL_OK;
}