#include "tclInt.h"
#include "tclPort.h"
typedef struct AcceptCallback {
char *script;
Tcl_Interp *interp;
} AcceptCallback;
static void AcceptCallbackProc _ANSI_ARGS_((ClientData callbackData,
Tcl_Channel chan, char *address, int port));
static void RegisterTcpServerInterpCleanup _ANSI_ARGS_((Tcl_Interp *interp,
AcceptCallback *acceptCallbackPtr));
static void TcpAcceptCallbacksDeleteProc _ANSI_ARGS_((
ClientData clientData, Tcl_Interp *interp));
static void TcpServerCloseProc _ANSI_ARGS_((ClientData callbackData));
static void UnregisterTcpServerInterpCleanupProc _ANSI_ARGS_((
Tcl_Interp *interp, AcceptCallback *acceptCallbackPtr));
int
Tcl_PutsObjCmd(dummy, interp, objc, objv)
ClientData dummy;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
Tcl_Channel chan;
Tcl_Obj *string;
int newline;
char *channelId;
int result;
int mode;
switch (objc) {
case 2:
string = objv[1];
newline = 1;
channelId = "stdout";
break;
case 3:
if (strcmp(Tcl_GetString(objv[1]), "-nonewline") == 0) {
newline = 0;
channelId = "stdout";
} else {
newline = 1;
channelId = Tcl_GetString(objv[1]);
}
string = objv[2];
break;
case 4:
if (strcmp(Tcl_GetString(objv[1]), "-nonewline") == 0) {
channelId = Tcl_GetString(objv[2]);
string = objv[3];
} else {
char *arg;
int length;
arg = Tcl_GetStringFromObj(objv[3], &length);
if (strncmp(arg, "nonewline", (size_t) length) != 0) {
Tcl_AppendResult(interp, "bad argument \"", arg,
"\": should be \"nonewline\"",
(char *) NULL);
return TCL_ERROR;
}
channelId = Tcl_GetString(objv[1]);
string = objv[2];
}
newline = 0;
break;
default:
Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? ?channelId? string");
return TCL_ERROR;
}
chan = Tcl_GetChannel(interp, channelId, &mode);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
if ((mode & TCL_WRITABLE) == 0) {
Tcl_AppendResult(interp, "channel \"", channelId,
"\" wasn't opened for writing", (char *) NULL);
return TCL_ERROR;
}
result = Tcl_WriteObj(chan, string);
if (result < 0) {
goto error;
}
if (newline != 0) {
result = Tcl_WriteChars(chan, "\n", 1);
if (result < 0) {
goto error;
}
}
return TCL_OK;
error:
Tcl_AppendResult(interp, "error writing \"", channelId, "\": ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
int
Tcl_FlushObjCmd(dummy, interp, objc, objv)
ClientData dummy;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
Tcl_Channel chan;
char *channelId;
int mode;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId");
return TCL_ERROR;
}
channelId = Tcl_GetString(objv[1]);
chan = Tcl_GetChannel(interp, channelId, &mode);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
if ((mode & TCL_WRITABLE) == 0) {
Tcl_AppendResult(interp, "channel \"", channelId,
"\" wasn't opened for writing", (char *) NULL);
return TCL_ERROR;
}
if (Tcl_Flush(chan) != TCL_OK) {
Tcl_AppendResult(interp, "error flushing \"", channelId, "\": ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
return TCL_OK;
}
int
Tcl_GetsObjCmd(dummy, interp, objc, objv)
ClientData dummy;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
Tcl_Channel chan;
int lineLen;
int mode;
char *name;
Tcl_Obj *resultPtr, *linePtr;
if ((objc != 2) && (objc != 3)) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId ?varName?");
return TCL_ERROR;
}
name = Tcl_GetString(objv[1]);
chan = Tcl_GetChannel(interp, name, &mode);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
if ((mode & TCL_READABLE) == 0) {
Tcl_AppendResult(interp, "channel \"", name,
"\" wasn't opened for reading", (char *) NULL);
return TCL_ERROR;
}
linePtr = Tcl_NewObj();
lineLen = Tcl_GetsObj(chan, linePtr);
if (lineLen < 0) {
if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) {
Tcl_DecrRefCount(linePtr);
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "error reading \"", name, "\": ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
lineLen = -1;
}
if (objc == 3) {
if (Tcl_ObjSetVar2(interp, objv[2], NULL, linePtr,
TCL_LEAVE_ERR_MSG) == NULL) {
Tcl_DecrRefCount(linePtr);
return TCL_ERROR;
}
resultPtr = Tcl_GetObjResult(interp);
Tcl_SetIntObj(resultPtr, lineLen);
return TCL_OK;
} else {
Tcl_SetObjResult(interp, linePtr);
}
return TCL_OK;
}
int
Tcl_ReadObjCmd(dummy, interp, objc, objv)
ClientData dummy;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
Tcl_Channel chan;
int newline, i;
int toRead;
int charactersRead;
int mode;
char *name;
Tcl_Obj *resultPtr;
if ((objc != 2) && (objc != 3)) {
argerror:
Tcl_WrongNumArgs(interp, 1, objv, "channelId ?numChars?");
Tcl_AppendResult(interp, " or \"", Tcl_GetString(objv[0]),
" ?-nonewline? channelId\"", (char *) NULL);
return TCL_ERROR;
}
i = 1;
newline = 0;
if (strcmp(Tcl_GetString(objv[1]), "-nonewline") == 0) {
newline = 1;
i++;
}
if (i == objc) {
goto argerror;
}
name = Tcl_GetString(objv[i]);
chan = Tcl_GetChannel(interp, name, &mode);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
if ((mode & TCL_READABLE) == 0) {
Tcl_AppendResult(interp, "channel \"", name,
"\" wasn't opened for reading", (char *) NULL);
return TCL_ERROR;
}
i++;
toRead = -1;
if (i < objc) {
char *arg;
arg = Tcl_GetString(objv[i]);
if (isdigit(UCHAR(arg[0]))) {
if (Tcl_GetIntFromObj(interp, objv[i], &toRead) != TCL_OK) {
return TCL_ERROR;
}
} else if (strcmp(arg, "nonewline") == 0) {
newline = 1;
} else {
Tcl_AppendResult(interp, "bad argument \"", arg,
"\": should be \"nonewline\"", (char *) NULL);
return TCL_ERROR;
}
}
resultPtr = Tcl_NewObj();
Tcl_IncrRefCount(resultPtr);
charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
if (charactersRead < 0) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "error reading \"", name, "\": ",
Tcl_PosixError(interp), (char *) NULL);
Tcl_DecrRefCount(resultPtr);
return TCL_ERROR;
}
if ((charactersRead > 0) && (newline != 0)) {
char *result;
int length;
result = Tcl_GetStringFromObj(resultPtr, &length);
if (result[length - 1] == '\n') {
Tcl_SetObjLength(resultPtr, length - 1);
}
}
Tcl_SetObjResult(interp, resultPtr);
Tcl_DecrRefCount(resultPtr);
return TCL_OK;
}
int
Tcl_SeekObjCmd(clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
Tcl_Channel chan;
Tcl_WideInt offset;
int mode;
Tcl_WideInt result;
char *chanName;
int optionIndex;
static CONST char *originOptions[] = {
"start", "current", "end", (char *) NULL
};
static int modeArray[] = {SEEK_SET, SEEK_CUR, SEEK_END};
if ((objc != 3) && (objc != 4)) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId offset ?origin?");
return TCL_ERROR;
}
chanName = Tcl_GetString(objv[1]);
chan = Tcl_GetChannel(interp, chanName, NULL);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
if (Tcl_GetWideIntFromObj(interp, objv[2], &offset) != TCL_OK) {
return TCL_ERROR;
}
mode = SEEK_SET;
if (objc == 4) {
if (Tcl_GetIndexFromObj(interp, objv[3], originOptions, "origin", 0,
&optionIndex) != TCL_OK) {
return TCL_ERROR;
}
mode = modeArray[optionIndex];
}
result = Tcl_Seek(chan, offset, mode);
if (result == Tcl_LongAsWide(-1)) {
Tcl_AppendResult(interp, "error during seek on \"",
chanName, "\": ", Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
return TCL_OK;
}
int
Tcl_TellObjCmd(clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
Tcl_Channel chan;
char *chanName;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId");
return TCL_ERROR;
}
chanName = Tcl_GetString(objv[1]);
chan = Tcl_GetChannel(interp, chanName, NULL);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
Tcl_SetWideIntObj(Tcl_GetObjResult(interp), Tcl_Tell(chan));
return TCL_OK;
}
int
Tcl_CloseObjCmd(clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
Tcl_Channel chan;
char *arg;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId");
return TCL_ERROR;
}
arg = Tcl_GetString(objv[1]);
chan = Tcl_GetChannel(interp, arg, NULL);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
if (Tcl_UnregisterChannel(interp, chan) != TCL_OK) {
Tcl_Obj *resultPtr;
char *string;
int len;
resultPtr = Tcl_GetObjResult(interp);
string = Tcl_GetStringFromObj(resultPtr, &len);
if ((len > 0) && (string[len - 1] == '\n')) {
Tcl_SetObjLength(resultPtr, len - 1);
}
return TCL_ERROR;
}
return TCL_OK;
}
int
Tcl_FconfigureObjCmd(clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
char *chanName, *optionName, *valueName;
Tcl_Channel chan;
int i;
Tcl_DString ds;
if ((objc < 2) || (((objc % 2) == 1) && (objc != 3))) {
Tcl_WrongNumArgs(interp, 1, objv,
"channelId ?optionName? ?value? ?optionName value?...");
return TCL_ERROR;
}
chanName = Tcl_GetString(objv[1]);
chan = Tcl_GetChannel(interp, chanName, NULL);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
if (objc == 2) {
Tcl_DStringInit(&ds);
if (Tcl_GetChannelOption(interp, chan, (char *) NULL, &ds) != TCL_OK) {
Tcl_DStringFree(&ds);
return TCL_ERROR;
}
Tcl_DStringResult(interp, &ds);
return TCL_OK;
}
if (objc == 3) {
Tcl_DStringInit(&ds);
optionName = Tcl_GetString(objv[2]);
if (Tcl_GetChannelOption(interp, chan, optionName, &ds) != TCL_OK) {
Tcl_DStringFree(&ds);
return TCL_ERROR;
}
Tcl_DStringResult(interp, &ds);
return TCL_OK;
}
for (i = 3; i < objc; i += 2) {
optionName = Tcl_GetString(objv[i-1]);
valueName = Tcl_GetString(objv[i]);
if (Tcl_SetChannelOption(interp, chan, optionName, valueName)
!= TCL_OK) {
return TCL_ERROR;
}
}
return TCL_OK;
}
int
Tcl_EofObjCmd(unused, interp, objc, objv)
ClientData unused;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
Tcl_Channel chan;
int dummy;
char *arg;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId");
return TCL_ERROR;
}
arg = Tcl_GetString(objv[1]);
chan = Tcl_GetChannel(interp, arg, &dummy);
if (chan == NULL) {
return TCL_ERROR;
}
Tcl_SetBooleanObj(Tcl_GetObjResult(interp), Tcl_Eof(chan));
return TCL_OK;
}
int
Tcl_ExecObjCmd(dummy, interp, objc, objv)
ClientData dummy;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
#ifdef MAC_TCL
Tcl_AppendResult(interp, "exec not implemented under Mac OS",
(char *)NULL);
return TCL_ERROR;
#else
#define NUM_ARGS 20
Tcl_Obj *resultPtr;
CONST char **argv;
char *string;
Tcl_Channel chan;
CONST char *argStorage[NUM_ARGS];
int argc, background, i, index, keepNewline, result, skip, length;
static CONST char *options[] = {
"-keepnewline", "--", NULL
};
enum options {
EXEC_KEEPNEWLINE, EXEC_LAST
};
keepNewline = 0;
for (skip = 1; skip < objc; skip++) {
string = Tcl_GetString(objv[skip]);
if (string[0] != '-') {
break;
}
if (Tcl_GetIndexFromObj(interp, objv[skip], options, "switch",
TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
if (index == EXEC_KEEPNEWLINE) {
keepNewline = 1;
} else {
skip++;
break;
}
}
if (objc <= skip) {
Tcl_WrongNumArgs(interp, 1, objv, "?switches? arg ?arg ...?");
return TCL_ERROR;
}
background = 0;
string = Tcl_GetString(objv[objc - 1]);
if ((string[0] == '&') && (string[1] == '\0')) {
objc--;
background = 1;
}
argv = argStorage;
argc = objc - skip;
if ((argc + 1) > sizeof(argv) / sizeof(argv[0])) {
argv = (CONST char **) ckalloc((unsigned)(argc + 1) * sizeof(char *));
}
for (i = 0; i < argc; i++) {
argv[i] = Tcl_GetString(objv[i + skip]);
}
argv[argc] = NULL;
chan = Tcl_OpenCommandChannel(interp, argc, argv,
(background ? 0 : TCL_STDOUT | TCL_STDERR));
if (argv != argStorage) {
ckfree((char *)argv);
}
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
if (background) {
TclGetAndDetachPids(interp, chan);
if (Tcl_Close(interp, chan) != TCL_OK) {
return TCL_ERROR;
}
return TCL_OK;
}
resultPtr = Tcl_NewObj();
if (Tcl_GetChannelHandle(chan, TCL_READABLE, NULL) == TCL_OK) {
if (Tcl_ReadChars(chan, resultPtr, -1, 0) < 0) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "error reading output from command: ",
Tcl_PosixError(interp), (char *) NULL);
Tcl_DecrRefCount(resultPtr);
return TCL_ERROR;
}
}
result = Tcl_Close(interp, chan);
string = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);
Tcl_AppendToObj(resultPtr, string, length);
if (keepNewline == 0) {
string = Tcl_GetStringFromObj(resultPtr, &length);
if ((length > 0) && (string[length - 1] == '\n')) {
Tcl_SetObjLength(resultPtr, length - 1);
}
}
Tcl_SetObjResult(interp, resultPtr);
return result;
#endif
}
int
Tcl_FblockedObjCmd(unused, interp, objc, objv)
ClientData unused;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
Tcl_Channel chan;
int mode;
char *arg;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId");
return TCL_ERROR;
}
arg = Tcl_GetString(objv[1]);
chan = Tcl_GetChannel(interp, arg, &mode);
if (chan == NULL) {
return TCL_ERROR;
}
if ((mode & TCL_READABLE) == 0) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
arg, "\" wasn't opened for reading", (char *) NULL);
return TCL_ERROR;
}
Tcl_SetBooleanObj(Tcl_GetObjResult(interp), Tcl_InputBlocked(chan));
return TCL_OK;
}
int
Tcl_OpenObjCmd(notUsed, interp, objc, objv)
ClientData notUsed;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
int pipeline, prot;
char *modeString, *what;
Tcl_Channel chan;
if ((objc < 2) || (objc > 4)) {
Tcl_WrongNumArgs(interp, 1, objv, "fileName ?access? ?permissions?");
return TCL_ERROR;
}
prot = 0666;
if (objc == 2) {
modeString = "r";
} else {
modeString = Tcl_GetString(objv[2]);
if (objc == 4) {
if (Tcl_GetIntFromObj(interp, objv[3], &prot) != TCL_OK) {
return TCL_ERROR;
}
}
}
pipeline = 0;
what = Tcl_GetString(objv[1]);
if (what[0] == '|') {
pipeline = 1;
}
if (!pipeline) {
chan = Tcl_FSOpenFileChannel(interp, objv[1], modeString, prot);
} else {
#ifdef MAC_TCL
Tcl_AppendResult(interp,
"command pipelines not supported on Macintosh OS",
(char *)NULL);
return TCL_ERROR;
#else
int mode, seekFlag, cmdObjc;
CONST char **cmdArgv;
if (Tcl_SplitList(interp, what+1, &cmdObjc, &cmdArgv) != TCL_OK) {
return TCL_ERROR;
}
mode = TclGetOpenMode(interp, modeString, &seekFlag);
if (mode == -1) {
chan = NULL;
} else {
int flags = TCL_STDERR | TCL_ENFORCE_MODE;
switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
case O_RDONLY:
flags |= TCL_STDOUT;
break;
case O_WRONLY:
flags |= TCL_STDIN;
break;
case O_RDWR:
flags |= (TCL_STDIN | TCL_STDOUT);
break;
default:
panic("Tcl_OpenCmd: invalid mode value");
break;
}
chan = Tcl_OpenCommandChannel(interp, cmdObjc, cmdArgv, flags);
}
ckfree((char *) cmdArgv);
#endif
}
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
Tcl_RegisterChannel(interp, chan);
Tcl_AppendResult(interp, Tcl_GetChannelName(chan), (char *) NULL);
return TCL_OK;
}
static void
TcpAcceptCallbacksDeleteProc(clientData, interp)
ClientData clientData;
Tcl_Interp *interp;
{
Tcl_HashTable *hTblPtr;
Tcl_HashEntry *hPtr;
Tcl_HashSearch hSearch;
AcceptCallback *acceptCallbackPtr;
hTblPtr = (Tcl_HashTable *) clientData;
for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
hPtr != (Tcl_HashEntry *) NULL;
hPtr = Tcl_NextHashEntry(&hSearch)) {
acceptCallbackPtr = (AcceptCallback *) Tcl_GetHashValue(hPtr);
acceptCallbackPtr->interp = (Tcl_Interp *) NULL;
}
Tcl_DeleteHashTable(hTblPtr);
ckfree((char *) hTblPtr);
}
static void
RegisterTcpServerInterpCleanup(interp, acceptCallbackPtr)
Tcl_Interp *interp;
AcceptCallback *acceptCallbackPtr;
{
Tcl_HashTable *hTblPtr;
Tcl_HashEntry *hPtr;
int new;
hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp,
"tclTCPAcceptCallbacks",
NULL);
if (hTblPtr == (Tcl_HashTable *) NULL) {
hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable));
Tcl_InitHashTable(hTblPtr, TCL_ONE_WORD_KEYS);
(void) Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks",
TcpAcceptCallbacksDeleteProc, (ClientData) hTblPtr);
}
hPtr = Tcl_CreateHashEntry(hTblPtr, (char *) acceptCallbackPtr, &new);
if (!new) {
panic("RegisterTcpServerCleanup: damaged accept record table");
}
Tcl_SetHashValue(hPtr, (ClientData) acceptCallbackPtr);
}
static void
UnregisterTcpServerInterpCleanupProc(interp, acceptCallbackPtr)
Tcl_Interp *interp;
AcceptCallback *acceptCallbackPtr;
{
Tcl_HashTable *hTblPtr;
Tcl_HashEntry *hPtr;
hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp,
"tclTCPAcceptCallbacks", NULL);
if (hTblPtr == (Tcl_HashTable *) NULL) {
return;
}
hPtr = Tcl_FindHashEntry(hTblPtr, (char *) acceptCallbackPtr);
if (hPtr == (Tcl_HashEntry *) NULL) {
return;
}
Tcl_DeleteHashEntry(hPtr);
}
static void
AcceptCallbackProc(callbackData, chan, address, port)
ClientData callbackData;
Tcl_Channel chan;
char *address;
int port;
{
AcceptCallback *acceptCallbackPtr;
Tcl_Interp *interp;
char *script;
char portBuf[TCL_INTEGER_SPACE];
int result;
acceptCallbackPtr = (AcceptCallback *) callbackData;
if (acceptCallbackPtr->interp != (Tcl_Interp *) NULL) {
script = acceptCallbackPtr->script;
interp = acceptCallbackPtr->interp;
Tcl_Preserve((ClientData) script);
Tcl_Preserve((ClientData) interp);
TclFormatInt(portBuf, port);
Tcl_RegisterChannel(interp, chan);
Tcl_RegisterChannel((Tcl_Interp *) NULL, chan);
result = Tcl_VarEval(interp, script, " ", Tcl_GetChannelName(chan),
" ", address, " ", portBuf, (char *) NULL);
if (result != TCL_OK) {
Tcl_BackgroundError(interp);
Tcl_UnregisterChannel(interp, chan);
}
Tcl_UnregisterChannel((Tcl_Interp *) NULL, chan);
Tcl_Release((ClientData) interp);
Tcl_Release((ClientData) script);
} else {
Tcl_Close((Tcl_Interp *) NULL, chan);
}
}
static void
TcpServerCloseProc(callbackData)
ClientData callbackData;
{
AcceptCallback *acceptCallbackPtr;
acceptCallbackPtr = (AcceptCallback *) callbackData;
if (acceptCallbackPtr->interp != (Tcl_Interp *) NULL) {
UnregisterTcpServerInterpCleanupProc(acceptCallbackPtr->interp,
acceptCallbackPtr);
}
Tcl_EventuallyFree((ClientData) acceptCallbackPtr->script, TCL_DYNAMIC);
ckfree((char *) acceptCallbackPtr);
}
int
Tcl_SocketObjCmd(notUsed, interp, objc, objv)
ClientData notUsed;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
static CONST char *socketOptions[] = {
"-async", "-myaddr", "-myport","-server", (char *) NULL
};
enum socketOptions {
SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_SERVER
};
int optionIndex, a, server, port;
char *arg, *copyScript, *host, *script;
char *myaddr = NULL;
int myport = 0;
int async = 0;
Tcl_Channel chan;
AcceptCallback *acceptCallbackPtr;
server = 0;
script = NULL;
if (TclpHasSockets(interp) != TCL_OK) {
return TCL_ERROR;
}
for (a = 1; a < objc; a++) {
arg = Tcl_GetString(objv[a]);
if (arg[0] != '-') {
break;
}
if (Tcl_GetIndexFromObj(interp, objv[a], socketOptions,
"option", TCL_EXACT, &optionIndex) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum socketOptions) optionIndex) {
case SKT_ASYNC: {
if (server == 1) {
Tcl_AppendResult(interp,
"cannot set -async option for server sockets",
(char *) NULL);
return TCL_ERROR;
}
async = 1;
break;
}
case SKT_MYADDR: {
a++;
if (a >= objc) {
Tcl_AppendResult(interp,
"no argument given for -myaddr option",
(char *) NULL);
return TCL_ERROR;
}
myaddr = Tcl_GetString(objv[a]);
break;
}
case SKT_MYPORT: {
char *myPortName;
a++;
if (a >= objc) {
Tcl_AppendResult(interp,
"no argument given for -myport option",
(char *) NULL);
return TCL_ERROR;
}
myPortName = Tcl_GetString(objv[a]);
if (TclSockGetPort(interp, myPortName, "tcp", &myport)
!= TCL_OK) {
return TCL_ERROR;
}
break;
}
case SKT_SERVER: {
if (async == 1) {
Tcl_AppendResult(interp,
"cannot set -async option for server sockets",
(char *) NULL);
return TCL_ERROR;
}
server = 1;
a++;
if (a >= objc) {
Tcl_AppendResult(interp,
"no argument given for -server option",
(char *) NULL);
return TCL_ERROR;
}
script = Tcl_GetString(objv[a]);
break;
}
default: {
panic("Tcl_SocketObjCmd: bad option index to SocketOptions");
}
}
}
if (server) {
host = myaddr;
if (myport != 0) {
Tcl_AppendResult(interp, "Option -myport is not valid for servers",
NULL);
return TCL_ERROR;
}
} else if (a < objc) {
host = Tcl_GetString(objv[a]);
a++;
} else {
wrongNumArgs:
Tcl_AppendResult(interp, "wrong # args: should be either:\n",
Tcl_GetString(objv[0]),
" ?-myaddr addr? ?-myport myport? ?-async? host port\n",
Tcl_GetString(objv[0]),
" -server command ?-myaddr addr? port",
(char *) NULL);
return TCL_ERROR;
}
if (a == objc-1) {
if (TclSockGetPort(interp, Tcl_GetString(objv[a]),
"tcp", &port) != TCL_OK) {
return TCL_ERROR;
}
} else {
goto wrongNumArgs;
}
if (server) {
acceptCallbackPtr = (AcceptCallback *) ckalloc((unsigned)
sizeof(AcceptCallback));
copyScript = ckalloc((unsigned) strlen(script) + 1);
strcpy(copyScript, script);
acceptCallbackPtr->script = copyScript;
acceptCallbackPtr->interp = interp;
chan = Tcl_OpenTcpServer(interp, port, host, AcceptCallbackProc,
(ClientData) acceptCallbackPtr);
if (chan == (Tcl_Channel) NULL) {
ckfree(copyScript);
ckfree((char *) acceptCallbackPtr);
return TCL_ERROR;
}
RegisterTcpServerInterpCleanup(interp, acceptCallbackPtr);
Tcl_CreateCloseHandler(chan, TcpServerCloseProc,
(ClientData) acceptCallbackPtr);
} else {
chan = Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
}
Tcl_RegisterChannel(interp, chan);
Tcl_AppendResult(interp, Tcl_GetChannelName(chan), (char *) NULL);
return TCL_OK;
}
int
Tcl_FcopyObjCmd(dummy, interp, objc, objv)
ClientData dummy;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
Tcl_Channel inChan, outChan;
char *arg;
int mode, i;
int toRead, index;
Tcl_Obj *cmdPtr;
static CONST char* switches[] = { "-size", "-command", NULL };
enum { FcopySize, FcopyCommand };
if ((objc < 3) || (objc > 7) || (objc == 4) || (objc == 6)) {
Tcl_WrongNumArgs(interp, 1, objv,
"input output ?-size size? ?-command callback?");
return TCL_ERROR;
}
arg = Tcl_GetString(objv[1]);
inChan = Tcl_GetChannel(interp, arg, &mode);
if (inChan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
if ((mode & TCL_READABLE) == 0) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
Tcl_GetString(objv[1]),
"\" wasn't opened for reading", (char *) NULL);
return TCL_ERROR;
}
arg = Tcl_GetString(objv[2]);
outChan = Tcl_GetChannel(interp, arg, &mode);
if (outChan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
if ((mode & TCL_WRITABLE) == 0) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
Tcl_GetString(objv[1]),
"\" wasn't opened for writing", (char *) NULL);
return TCL_ERROR;
}
toRead = -1;
cmdPtr = NULL;
for (i = 3; i < objc; i += 2) {
if (Tcl_GetIndexFromObj(interp, objv[i], switches, "switch", 0,
(int *) &index) != TCL_OK) {
return TCL_ERROR;
}
switch (index) {
case FcopySize:
if (Tcl_GetIntFromObj(interp, objv[i+1], &toRead) != TCL_OK) {
return TCL_ERROR;
}
break;
case FcopyCommand:
cmdPtr = objv[i+1];
break;
}
}
return TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr);
}