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; }