static int
ChannelClose(ClientData instance, Tcl_Interp *interp)
{
Channel *instPtr = instance;
Package *pkgPtr = instPtr->pkgPtr;
Channel **tmpPtrPtr;
int r = TCL_OK;
FT_STATUS fts;
TRACE("ChannelClose\n");
CloseHandle(instPtr->event);
if ((fts = procs.FT_Purge(instPtr->handle, FT_PURGE_RX | FT_PURGE_TX)) != FT_OK) {
TRACE("ChannelClose error: %s", ConvertError(fts));
}
fts = procs.FT_Close(instPtr->handle);
if (fts != FT_OK) {
if (interp != NULL) {
Tcl_AppendResult(interp, "error closing \"",
Tcl_GetChannelName(instPtr->channel), "\": ",
ConvertError(fts), NULL);
}
r = TCL_ERROR;
}
/* remove this channel from the package list */
tmpPtrPtr = &pkgPtr->headPtr;
while (*tmpPtrPtr && *tmpPtrPtr != instPtr) {
tmpPtrPtr = &(*tmpPtrPtr)->nextPtr;
}
*tmpPtrPtr = instPtr->nextPtr;
--pkgPtr->count;
ckfree((char *)instPtr);
return r;
}
int
TestObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
{
Tcl_Channel chan = NULL, chan2 = NULL;
Tcl_Obj *resObj = NULL;
char *type = "";
int r = TCL_OK;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "type");
return TCL_ERROR;
}
type = Tcl_GetString(objv[1]);
if (strcmp("memchan", type) == 0) {
chan = Memchan_CreateMemoryChannel(interp, 0);
} else if (strcmp("fifo", type) == 0) {
chan = Memchan_CreateFifoChannel(interp);
} else if (strcmp("fifo2", type) == 0) {
Memchan_CreateFifo2Channel(interp, &chan, &chan2);
} else if (strcmp("null", type) == 0) {
chan = Memchan_CreateNullChannel(interp);
} else if (strcmp("zero", type) == 0) {
chan = Memchan_CreateZeroChannel(interp);
} else if (strcmp("random", type) == 0) {
chan = Memchan_CreateRandomChannel(interp);
}
if (chan2 != NULL) {
Tcl_Obj *name[2];
name[0] = Tcl_NewStringObj(Tcl_GetChannelName(chan), -1);
name[1] = Tcl_NewStringObj(Tcl_GetChannelName(chan2), -1);
resObj = Tcl_NewListObj(2, name);
r = TCL_OK;
} else if (chan != NULL) {
resObj = Tcl_NewStringObj(Tcl_GetChannelName(chan), -1);
r = TCL_OK;
} else {
resObj = Tcl_NewStringObj("error", -1);
r = TCL_ERROR;
}
Tcl_SetObjResult(interp, resObj);
return r;
}
/*-----------------------------------------------------------------------------
* BindFileHandles --
*
* Bind the file handles for a socket to one or two Tcl file channels.
* Binding to two handles is for compatibility with older interfaces.
* If an error occurs, both file descriptors will be closed and cleaned up.
*
* Parameters:
* o interp (O) - File handles or error messages are return in result.
* o options (I) - Options set controling buffering and handle allocation:
* o SERVER_BUF - Two file handle buffering.
* o SERVER_NOBUF - No buffering.
* o socketFD (I) - File number of the socket that was opened.
* Returns:
* TCL_OK or TCL_ERROR.
*-----------------------------------------------------------------------------
*/
static int
BindFileHandles (Tcl_Interp *interp, unsigned options, int socketFD)
{
Tcl_Channel channel;
channel = Tcl_MakeTcpClientChannel ((ClientData) socketFD);
Tcl_RegisterChannel (interp, channel);
if (options & SERVER_NOBUF) {
if (TclX_SetChannelOption (interp, channel, TCLX_COPT_BUFFERING,
TCLX_BUFFERING_NONE) == TCL_ERROR)
goto errorExit;
}
Tcl_AppendElement (interp, Tcl_GetChannelName (channel));
return TCL_OK;
errorExit:
CloseForError (interp, channel, socketFD);
return TCL_ERROR;
}
/*
* Get the connection Id from the result Id
*/
int
PgGetConnByResultId(Tcl_Interp *interp, CONST84 char *resid_c)
{
char *mark;
Tcl_Channel conn_chan;
if (!(mark = strchr(resid_c, '.')))
goto error_out;
*mark = '\0';
conn_chan = Tcl_GetChannel(interp, resid_c, 0);
*mark = '.';
if (conn_chan && Tcl_GetChannelType(conn_chan) == &Pg_ConnType)
{
Tcl_SetResult(interp, (char *) Tcl_GetChannelName(conn_chan),
TCL_VOLATILE);
return TCL_OK;
}
error_out:
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, resid_c, " is not a valid connection\n", 0);
return TCL_ERROR;
}
int
Tcl_SocketObjCmd(
ClientData notUsed, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
static const char *socketOptions[] = {
"-async", "-myaddr", "-myport","-server", NULL
};
enum socketOptions {
SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_SERVER
};
int optionIndex, a, server = 0, port, myport = 0, async = 0;
char *host, *script = NULL, *myaddr = NULL;
Tcl_Channel chan;
if (TclpHasSockets(interp) != TCL_OK) {
return TCL_ERROR;
}
for (a = 1; a < objc; a++) {
const char *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", NULL);
return TCL_ERROR;
}
async = 1;
break;
case SKT_MYADDR:
a++;
if (a >= objc) {
Tcl_AppendResult(interp,
"no argument given for -myaddr option", NULL);
return TCL_ERROR;
}
myaddr = TclGetString(objv[a]);
break;
case SKT_MYPORT: {
char *myPortName;
a++;
if (a >= objc) {
Tcl_AppendResult(interp,
"no argument given for -myport option", NULL);
return TCL_ERROR;
}
myPortName = TclGetString(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", NULL);
return TCL_ERROR;
}
server = 1;
a++;
if (a >= objc) {
Tcl_AppendResult(interp,
"no argument given for -server option", NULL);
return TCL_ERROR;
}
script = TclGetString(objv[a]);
break;
default:
Tcl_Panic("Tcl_SocketObjCmd: bad option index to SocketOptions");
}
}
if (server) {
host = myaddr; /* NULL implies INADDR_ANY */
if (myport != 0) {
Tcl_AppendResult(interp, "option -myport is not valid for servers",
NULL);
return TCL_ERROR;
}
} else if (a < objc) {
host = TclGetString(objv[a]);
a++;
} else {
Interp *iPtr;
wrongNumArgs:
iPtr = (Interp *) interp;
Tcl_WrongNumArgs(interp, 1, objv,
"?-myaddr addr? ?-myport myport? ?-async? host port");
iPtr->flags |= INTERP_ALTERNATE_WRONG_ARGS;
Tcl_WrongNumArgs(interp, 1, objv,
"-server command ?-myaddr addr? port");
iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS;
return TCL_ERROR;
}
if (a == objc-1) {
if (TclSockGetPort(interp, TclGetString(objv[a]), "tcp",
&port) != TCL_OK) {
return TCL_ERROR;
}
} else {
goto wrongNumArgs;
}
if (server) {
AcceptCallback *acceptCallbackPtr = (AcceptCallback *)
ckalloc((unsigned) sizeof(AcceptCallback));
unsigned len = strlen(script) + 1;
char *copyScript = ckalloc(len);
memcpy(copyScript, script, len);
acceptCallbackPtr->script = copyScript;
acceptCallbackPtr->interp = interp;
chan = Tcl_OpenTcpServer(interp, port, host, AcceptCallbackProc,
acceptCallbackPtr);
if (chan == NULL) {
ckfree(copyScript);
ckfree((char *) acceptCallbackPtr);
return TCL_ERROR;
}
/*
* Register with the interpreter to let us know when the interpreter
* is deleted (by having the callback set the interp field of the
* acceptCallbackPtr's structure to NULL). This is to avoid trying to
* eval the script in a deleted interpreter.
*/
RegisterTcpServerInterpCleanup(interp, acceptCallbackPtr);
/*
* Register a close callback. This callback will inform the
* interpreter (if it still exists) that this channel does not need to
* be informed when the interpreter is deleted.
*/
Tcl_CreateCloseHandler(chan, TcpServerCloseProc, acceptCallbackPtr);
} else {
chan = Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async);
if (chan == NULL) {
return TCL_ERROR;
}
}
Tcl_RegisterChannel(interp, chan);
Tcl_AppendResult(interp, Tcl_GetChannelName(chan), NULL);
return TCL_OK;
}
static void
AcceptCallbackProc(
ClientData callbackData, /* The data stored when the callback was
* created in the call to
* Tcl_OpenTcpServer. */
Tcl_Channel chan, /* Channel for the newly accepted
* connection. */
char *address, /* Address of client that was accepted. */
int port) /* Port of client that was accepted. */
{
AcceptCallback *acceptCallbackPtr = (AcceptCallback *) callbackData;
/*
* Check if the callback is still valid; the interpreter may have gone
* away, this is signalled by setting the interp field of the callback
* data to NULL.
*/
if (acceptCallbackPtr->interp != NULL) {
char portBuf[TCL_INTEGER_SPACE];
char *script = acceptCallbackPtr->script;
Tcl_Interp *interp = acceptCallbackPtr->interp;
int result;
Tcl_Preserve(script);
Tcl_Preserve(interp);
TclFormatInt(portBuf, port);
Tcl_RegisterChannel(interp, chan);
/*
* Artificially bump the refcount to protect the channel from being
* deleted while the script is being evaluated.
*/
Tcl_RegisterChannel(NULL, chan);
result = Tcl_VarEval(interp, script, " ", Tcl_GetChannelName(chan),
" ", address, " ", portBuf, NULL);
if (result != TCL_OK) {
TclBackgroundException(interp, result);
Tcl_UnregisterChannel(interp, chan);
}
/*
* Decrement the artificially bumped refcount. After this it is not
* safe anymore to use "chan", because it may now be deleted.
*/
Tcl_UnregisterChannel(NULL, chan);
Tcl_Release(interp);
Tcl_Release(script);
} else {
/*
* The interpreter has been deleted, so there is no useful way to
* utilize the client socket - just close it.
*/
Tcl_Close(NULL, chan);
}
}
/* ARGSUSED */
int
Tcl_OpenObjCmd(
ClientData notUsed, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int pipeline, prot;
const 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 = TclGetString(objv[2]);
if (objc == 4) {
char *permString = TclGetString(objv[3]);
int code = TCL_ERROR;
int scanned = TclParseAllWhiteSpace(permString, -1);
/* Support legacy octal numbers */
if ((permString[scanned] == '0')
&& (permString[scanned+1] >= '0')
&& (permString[scanned+1] <= '7')) {
Tcl_Obj *permObj;
TclNewLiteralStringObj(permObj, "0o");
Tcl_AppendToObj(permObj, permString+scanned+1, -1);
code = TclGetIntFromObj(NULL, permObj, &prot);
Tcl_DecrRefCount(permObj);
}
if ((code == TCL_ERROR)
&& TclGetIntFromObj(interp, objv[3], &prot) != TCL_OK) {
return TCL_ERROR;
}
}
}
pipeline = 0;
what = TclGetString(objv[1]);
if (what[0] == '|') {
pipeline = 1;
}
/*
* Open the file or create a process pipeline.
*/
if (!pipeline) {
chan = Tcl_FSOpenFileChannel(interp, objv[1], modeString, prot);
} else {
int mode, seekFlag, cmdObjc, binary;
const char **cmdArgv;
if (Tcl_SplitList(interp, what+1, &cmdObjc, &cmdArgv) != TCL_OK) {
return TCL_ERROR;
}
mode = TclGetOpenModeEx(interp, modeString, &seekFlag, &binary);
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:
Tcl_Panic("Tcl_OpenCmd: invalid mode value");
break;
}
chan = Tcl_OpenCommandChannel(interp, cmdObjc, cmdArgv, flags);
if (binary && chan) {
Tcl_SetChannelOption(interp, chan, "-translation", "binary");
}
}
ckfree((char *) cmdArgv);
}
if (chan == NULL) {
return TCL_ERROR;
}
Tcl_RegisterChannel(interp, chan);
Tcl_AppendResult(interp, Tcl_GetChannelName(chan), NULL);
return TCL_OK;
}
TclTextInterp::TclTextInterp(VMDApp *vmdapp, int guienabled, int mpienabled)
: app(vmdapp) {
interp = Tcl_CreateInterp();
#if 0
Tcl_InitMemory(interp); // enable Tcl memory debugging features
// when compiled with TCL_MEM_DEBUG
#endif
commandPtr = Tcl_NewObj();
Tcl_IncrRefCount(commandPtr);
consoleisatty = vmd_isatty(0); // whether we're interactive or not
ignorestdin = 0;
gotPartial = 0;
needPrompt = 1;
callLevel = 0;
starttime = delay = 0;
#if defined(VMDMPI)
//
// MPI builds of VMD cannot try to read any command input from the
// console because it creates shutdown problems, at least with MPICH.
// File-based command input is fine however.
//
// don't check for interactive console input if running in parallel
if (mpienabled)
ignorestdin = 1;
#endif
#if defined(ANDROIDARMV7A)
//
// For the time being, the Android builds won't attempt to get any
// console input. Any input we're going to get is going to come via
// some means other than stdin, such as a network socket, text box, etc.
//
// Don't check for interactive console input if compiled for Android
ignorestdin = 1;
#endif
// set tcl_interactive, lets us run unix commands as from a shell
#if !defined(VMD_NANOHUB)
Tcl_SetVar(interp, "tcl_interactive", "1", 0);
#else
Tcl_SetVar(interp, "tcl_interactive", "0", 0);
Tcl_Channel channel;
#define CLIENT_READ (3)
#define CLIENT_WRITE (4)
channel = Tcl_MakeFileChannel((ClientData)CLIENT_READ, TCL_READABLE);
if (channel != NULL) {
const char *result;
Tcl_RegisterChannel(interp, channel);
result = Tcl_SetVar2(interp, "vmd_client", "read",
Tcl_GetChannelName(channel),
TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
if (result == NULL) {
fprintf(stderr, "can't create variable for client read channel\n");
}
}
channel = Tcl_MakeFileChannel((ClientData)CLIENT_WRITE, TCL_WRITABLE);
if (channel != NULL) {
const char *result;
Tcl_RegisterChannel(interp, channel);
result = Tcl_SetVar2(interp, "vmd_client", "write",
Tcl_GetChannelName(channel),
TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
if (result == NULL) {
fprintf(stderr, "can't create variable for client write channel\n");
}
}
write(CLIENT_WRITE, "vmd 1.0\n", 8);
#endif
// pass our instance of VMDApp to a hash table assoc. with the interpreter
Tcl_SetAssocData(interp, "VMDApp", NULL, app);
// Set up argc, argv0, and argv variables
{
char argcbuf[20];
sprintf(argcbuf, "%d", app->argc_m);
Tcl_SetVar(interp, "argc", argcbuf, TCL_GLOBAL_ONLY);
// it might be better to use the same thing that was passed to
// Tcl_FindExecutable, but this is now
Tcl_SetVar(interp, "argv0", app->argv_m[0], TCL_GLOBAL_ONLY);
char *args = Tcl_Merge(app->argc_m-1, app->argv_m+1);
Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
Tcl_Free(args);
}
#if defined(_MSC_VER) && TCL_MINOR_VERSION >= 4
// The Windows versions of Tcl 8.5.x have trouble finding
// the Tcl library subdirectory for unknown reasons.
// We force the appropriate env variables to be set in Tcl,
// despite Windows.
{
char vmdinitscript[4096];
char * tcl_library = getenv("TCL_LIBRARY");
char * tk_library = getenv("TK_LIBRARY");
if (tcl_library) {
sprintf(vmdinitscript, "set env(TCL_LIBRARY) {%s}", tcl_library);
if (Tcl_Eval(interp, vmdinitscript) != TCL_OK) {
msgErr << Tcl_GetStringResult(interp) << sendmsg;
}
}
if (tk_library) {
sprintf(vmdinitscript, "set env(TK_LIBRARY) {%s}", tk_library);
if (Tcl_Eval(interp, vmdinitscript) != TCL_OK) {
msgErr << Tcl_GetStringResult(interp) << sendmsg;
}
}
}
#endif
if (Tcl_Init(interp) == TCL_ERROR) { // new with 7.6
msgErr << "Tcl startup error: " << Tcl_GetStringResult(interp) << sendmsg;
}
#ifdef VMDTK
// and the Tk commands (but only if a GUI is available!)
if (guienabled) {
if (Tk_Init(interp) == TCL_ERROR) {
msgErr << "Tk startup error: " << Tcl_GetStringResult(interp) << sendmsg;
} else {
Tcl_StaticPackage(interp, "Tk",
(Tcl_PackageInitProc *) Tk_Init,
(Tcl_PackageInitProc *) NULL);
}
} // end of check that GUI is allowed
#endif
add_commands();
}
int
TclFileTemporaryCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
Tcl_Obj *nameVarObj = NULL; /* Variable to store the name of the temporary
* file in. */
Tcl_Obj *nameObj = NULL; /* Object that will contain the filename. */
Tcl_Channel chan; /* The channel opened (RDWR) on the temporary
* file, or NULL if there's an error. */
Tcl_Obj *tempDirObj = NULL, *tempBaseObj = NULL, *tempExtObj = NULL;
/* Pieces of template. Each piece is NULL if
* it is omitted. The platform temporary file
* engine might ignore some pieces. */
if (objc < 1 || objc > 3) {
Tcl_WrongNumArgs(interp, 1, objv, "?nameVar? ?template?");
return TCL_ERROR;
}
if (objc > 1) {
nameVarObj = objv[1];
TclNewObj(nameObj);
}
if (objc > 2) {
int length;
Tcl_Obj *templateObj = objv[2];
const char *string = TclGetStringFromObj(templateObj, &length);
/*
* Treat an empty string as if it wasn't there.
*/
if (length == 0) {
goto makeTemporary;
}
/*
* The template only gives a directory if there is a directory
* separator in it.
*/
if (strchr(string, '/') != NULL
|| (tclPlatform == TCL_PLATFORM_WINDOWS
&& strchr(string, '\\') != NULL)) {
tempDirObj = TclPathPart(interp, templateObj, TCL_PATH_DIRNAME);
/*
* Only allow creation of temporary files in the native filesystem
* since they are frequently used for integration with external
* tools or system libraries. [Bug 2388866]
*/
if (tempDirObj != NULL && Tcl_FSGetFileSystemForPath(tempDirObj)
!= &tclNativeFilesystem) {
TclDecrRefCount(tempDirObj);
tempDirObj = NULL;
}
}
/*
* The template only gives the filename if the last character isn't a
* directory separator.
*/
if (string[length-1] != '/' && (tclPlatform != TCL_PLATFORM_WINDOWS
|| string[length-1] != '\\')) {
Tcl_Obj *tailObj = TclPathPart(interp, templateObj,
TCL_PATH_TAIL);
if (tailObj != NULL) {
tempBaseObj = TclPathPart(interp, tailObj, TCL_PATH_ROOT);
tempExtObj = TclPathPart(interp, tailObj, TCL_PATH_EXTENSION);
TclDecrRefCount(tailObj);
}
}
}
/*
* Convert empty parts of the template into unspecified parts.
*/
if (tempDirObj && !TclGetString(tempDirObj)[0]) {
TclDecrRefCount(tempDirObj);
tempDirObj = NULL;
}
if (tempBaseObj && !TclGetString(tempBaseObj)[0]) {
TclDecrRefCount(tempBaseObj);
tempBaseObj = NULL;
}
if (tempExtObj && !TclGetString(tempExtObj)[0]) {
TclDecrRefCount(tempExtObj);
tempExtObj = NULL;
}
/*
* Create and open the temporary file.
*/
makeTemporary:
chan = TclpOpenTemporaryFile(tempDirObj,tempBaseObj,tempExtObj, nameObj);
/*
* If we created pieces of template, get rid of them now.
*/
if (tempDirObj) {
TclDecrRefCount(tempDirObj);
}
if (tempBaseObj) {
TclDecrRefCount(tempBaseObj);
}
if (tempExtObj) {
TclDecrRefCount(tempExtObj);
}
/*
* Deal with results.
*/
if (chan == NULL) {
if (nameVarObj) {
TclDecrRefCount(nameObj);
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't create temporary file: %s", Tcl_PosixError(interp)));
return TCL_ERROR;
}
Tcl_RegisterChannel(interp, chan);
if (nameVarObj != NULL) {
if (Tcl_ObjSetVar2(interp, nameVarObj, NULL, nameObj,
TCL_LEAVE_ERR_MSG) == NULL) {
Tcl_UnregisterChannel(interp, chan);
return TCL_ERROR;
}
}
Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));
return TCL_OK;
}
/* ARGSUSED */
int
TclChannelTransform(
Tcl_Interp *interp, /* Interpreter for result. */
Tcl_Channel chan, /* Channel to transform. */
Tcl_Obj *cmdObjPtr) /* Script to use for transform. */
{
Channel *chanPtr; /* The actual channel. */
ChannelState *statePtr; /* State info for channel. */
int mode; /* Read/write mode of the channel. */
int objc;
TransformChannelData *dataPtr;
Tcl_DString ds;
if (chan == NULL) {
return TCL_ERROR;
}
if (TCL_OK != Tcl_ListObjLength(interp, cmdObjPtr, &objc)) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("-command value is not a list", -1));
return TCL_ERROR;
}
chanPtr = (Channel *) chan;
statePtr = chanPtr->state;
chanPtr = statePtr->topChanPtr;
chan = (Tcl_Channel) chanPtr;
mode = (statePtr->flags & (TCL_READABLE|TCL_WRITABLE));
/*
* Now initialize the transformation state and stack it upon the specified
* channel. One of the necessary things to do is to retrieve the blocking
* regime of the underlying channel and to use the same for us too.
*/
dataPtr = ckalloc(sizeof(TransformChannelData));
dataPtr->refCount = 1;
Tcl_DStringInit(&ds);
Tcl_GetChannelOption(interp, chan, "-blocking", &ds);
dataPtr->readIsFlushed = 0;
dataPtr->eofPending = 0;
dataPtr->flags = 0;
if (ds.string[0] == '0') {
dataPtr->flags |= CHANNEL_ASYNC;
}
Tcl_DStringFree(&ds);
dataPtr->watchMask = 0;
dataPtr->mode = mode;
dataPtr->timer = NULL;
dataPtr->maxRead = 4096; /* Initial value not relevant. */
dataPtr->interp = interp;
dataPtr->command = cmdObjPtr;
Tcl_IncrRefCount(dataPtr->command);
ResultInit(&dataPtr->result);
dataPtr->self = Tcl_StackChannel(interp, &transformChannelType, dataPtr,
mode, chan);
if (dataPtr->self == NULL) {
Tcl_AppendPrintfToObj(Tcl_GetObjResult(interp),
"\nfailed to stack channel \"%s\"", Tcl_GetChannelName(chan));
ReleaseData(dataPtr);
return TCL_ERROR;
}
Tcl_Preserve(dataPtr->self);
/*
* At last initialize the transformation at the script level.
*/
PreserveData(dataPtr);
if ((dataPtr->mode & TCL_WRITABLE) && ExecuteCallback(dataPtr, NULL,
A_CREATE_WRITE, NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE) != TCL_OK){
Tcl_UnstackChannel(interp, chan);
ReleaseData(dataPtr);
return TCL_ERROR;
}
if ((dataPtr->mode & TCL_READABLE) && ExecuteCallback(dataPtr, NULL,
A_CREATE_READ, NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE) != TCL_OK) {
ExecuteCallback(dataPtr, NULL, A_DELETE_WRITE, NULL, 0, TRANSMIT_DONT,
P_NO_PRESERVE);
Tcl_UnstackChannel(interp, chan);
ReleaseData(dataPtr);
return TCL_ERROR;
}
ReleaseData(dataPtr);
return TCL_OK;
}
static int
FileForRedirect(
Tcl_Interp *interp, /* Intepreter to use for error reporting. */
char *spec, /* Points to character just after redirection
* character. */
char *arg, /* Pointer to entire argument containing spec:
* used for error reporting. */
int atOK, /* Non-zero means that '@' notation can be
* used to specify a channel, zero means that
* it isn't. */
char *nextArg, /* Next argument in argc/argv array, if needed
* for file name or channel name. May be
* NULL. */
int flags, /* Flags to use for opening file or to specify
* mode for channel. */
int *skipPtr, /* (out) Filled with 1 if redirection target
* was in spec, 2 if it was in nextArg. */
int *closePtr) /* (out) Filled with one if the caller should
* close the file when done with it, zero
* otherwise. */
{
int writing = (flags & O_WRONLY);
int fd;
*skipPtr = 1;
if ((atOK != 0) && (*spec == '@')) {
int direction;
Tcl_Channel chan;
spec++;
if (*spec == '\0') {
spec = nextArg;
if (spec == NULL) {
goto badLastArg;
}
*skipPtr = 2;
}
chan = Tcl_GetChannel(interp, spec, NULL);
if (chan == NULL) {
return -1;
}
direction = (writing) ? TCL_WRITABLE : TCL_READABLE;
fd = GetFdFromChannel(chan, direction);
if (fd < 0) {
Tcl_AppendResult(interp, "channel \"", Tcl_GetChannelName(chan),
"\" wasn't opened for ",
((writing) ? "writing" : "reading"), (char *)NULL);
return -1;
}
if (writing) {
/*
* Be sure to flush output to the file, so that anything
* written by the child appears after stuff we've already
* written.
*/
Tcl_Flush(chan);
}
} else {
char *name;
Tcl_DString nameString;
if (*spec == '\0') {
spec = nextArg;
if (spec == NULL) {
goto badLastArg;
}
*skipPtr = 2;
}
name = Tcl_TranslateFileName(interp, spec, &nameString);
if (name != NULL) {
fd = OpenFile(name, flags);
} else {
fd = -1;
}
Tcl_DStringFree(&nameString);
if (fd < 0) {
Tcl_AppendResult(interp, "can't ",
((writing) ? "write" : "read"), " file \"", spec, "\": ",
Tcl_PosixError(interp), (char *)NULL);
return -1;
}
*closePtr = TRUE;
}
return fd;
badLastArg:
Tcl_AppendResult(interp, "can't specify \"", arg,
"\" as last word in command", (char *)NULL);
return -1;
}
/*-----------------------------------------------------------------------------
* TclX_ServerCreateCmd --
* Implements the TCL server_create command:
*
* server_create ?options?
*
* Creates a socket, binds the address and port on the local machine
* (optionally specified by the caller), and starts the port listening
* for connections by calling listen (2).
*
* Options may be "-myip ip_address", "-myport port_number",
* "-myport reserved", and "-backlog backlog".
*
* Results:
* If successful, a Tcl fileid is returned.
*
*-----------------------------------------------------------------------------
*/
static int
TclX_ServerCreateCmd (ClientData clientData,
Tcl_Interp *interp,
int argc,
const char **argv)
{
int socketFD = -1, nextArg;
struct sockaddr_in local;
int myPort, value;
int backlog = 5;
int getReserved = FALSE;
Tcl_Channel channel = NULL;
/*
* Parse arguments.
*/
bzero ((VOID *) &local, sizeof (local));
local.sin_family = AF_INET;
local.sin_addr.s_addr = INADDR_ANY;
nextArg = 1;
while ((nextArg < argc) && (argv [nextArg][0] == '-')) {
if (STREQU ("-myip", argv [nextArg])) {
if (nextArg >= argc - 1)
goto missingArg;
nextArg++;
if (TclXOSInetAtoN (interp, argv [nextArg],
&local.sin_addr) == TCL_ERROR)
return TCL_ERROR;
} else if (STREQU ("-myport", argv [nextArg])) {
if (nextArg >= argc - 1)
goto missingArg;
nextArg++;
if (STREQU (argv [nextArg], "reserved")) {
getReserved = TRUE;
} else {
if (Tcl_GetInt (interp, argv [nextArg], &myPort) != TCL_OK)
return TCL_ERROR;
local.sin_port = htons (myPort);
}
} else if (STREQU ("-backlog", argv [nextArg])) {
if (nextArg >= argc - 1)
goto missingArg;
nextArg++;
if (Tcl_GetInt (interp, argv [nextArg], &backlog) != TCL_OK)
return TCL_ERROR;
} else if (STREQU ("-reuseaddr", argv [nextArg])) {
/* Ignore for compatibility */
} else {
TclX_AppendObjResult (interp, "expected ",
"\"-myip\", \"-myport\", or \"-backlog\", ",
"got \"", argv [nextArg], "\"",
(char *) NULL);
return TCL_ERROR;
}
nextArg++;
}
if (nextArg != argc) {
TclX_AppendObjResult (interp, tclXWrongArgs, argv[0],
" ?options?", (char *) NULL);
return TCL_ERROR;
}
/*
* Allocate a reserved port if requested.
*/
if (getReserved) {
int port;
if (rresvport (&port) < 0)
goto unixError;
local.sin_port = port;
}
/*
* Open a socket and bind an address and port to it.
*/
socketFD = socket (local.sin_family, SOCK_STREAM, 0);
if (socketFD < 0)
goto unixError;
value = 1;
if (setsockopt (socketFD, SOL_SOCKET, SO_REUSEADDR,
(void*) &value, sizeof (value)) < 0) {
goto unixError;
}
if (bind (socketFD, (struct sockaddr *) &local, sizeof (local)) < 0) {
goto unixError;
}
if (listen (socketFD, backlog) < 0)
goto unixError;
channel = Tcl_MakeTcpClientChannel ((ClientData) socketFD);
Tcl_RegisterChannel (interp, channel);
TclX_AppendObjResult (interp, Tcl_GetChannelName (channel), (char *) NULL);
return TCL_OK;
/*
* Exit points for errors.
*/
missingArg:
TclX_AppendObjResult (interp, "missing argument for ", argv [nextArg],
(char *) NULL);
return TCL_ERROR;
unixError:
TclX_AppendObjResult (interp, Tcl_PosixError (interp), (char *) NULL);
CloseForError (interp, channel, socketFD);
return TCL_ERROR;
}
