Channel IvyChannelAdd(IVY_HANDLE fd, void *data, ChannelHandleDelete handle_delete, ChannelHandleRead handle_read, ChannelHandleWrite handle_write ) { Channel channel; channel = (Channel)ckalloc( sizeof (struct _channel) ); if ( !channel ) { fprintf(stderr,"NOK Memory Alloc Error\n"); exit(0); } channel->handle_delete = handle_delete; channel->handle_read = handle_read; channel->handle_write = handle_write; channel->data = data; channel->fd = fd; /*printf("Create handle fd %d\n", fd);*/ channel->tcl_channel = Tcl_MakeTcpClientChannel((void*) (long) fd); Tcl_CreateChannelHandler(channel->tcl_channel, TCL_READABLE|TCL_EXCEPTION, IvyHandleFd, (ClientData) channel); return channel; }
static Tcl_Channel tcl_channel(value fd, int flags) { HANDLE h = Handle_val(fd); int optval, optsize; optsize = sizeof(optval); if (getsockopt((SOCKET) h, SOL_SOCKET, SO_TYPE, (char *)&optval, &optsize) == 0) return Tcl_MakeTcpClientChannel((ClientData) h); else return Tcl_MakeFileChannel((ClientData) h, flags); }
void TnmCreateSocketHandler(int sock, int mask, TnmSocketProc *proc, ClientData clientData) { SocketHandler *shPtr; shPtr = (SocketHandler *) ckalloc(sizeof(SocketHandler)); shPtr->sd = sock; shPtr->channel = Tcl_MakeTcpClientChannel((ClientData) sock); shPtr->proc = proc; shPtr->clientData = clientData; Tcl_RegisterChannel((Tcl_Interp *) NULL, shPtr->channel); Tcl_CreateChannelHandler(shPtr->channel, mask, proc, clientData); shPtr->nextPtr = socketHandlerList; socketHandlerList = shPtr; }
/* * Create and register a new channel for the connection */ void PgSetConnectionId(Tcl_Interp *interp, PGconn *conn) { Tcl_Channel conn_chan; Pg_ConnectionId *connid; int i; connid = (Pg_ConnectionId *) ckalloc(sizeof(Pg_ConnectionId)); connid->conn = conn; connid->res_count = 0; connid->res_last = -1; connid->res_max = RES_START; connid->res_hardmax = RES_HARD_MAX; connid->res_copy = -1; connid->res_copyStatus = RES_COPY_NONE; connid->results = (PGresult **) ckalloc(sizeof(PGresult *) * RES_START); for (i = 0; i < RES_START; i++) connid->results[i] = NULL; connid->notify_list = NULL; connid->notifier_running = 0; sprintf(connid->id, "pgsql%d", PQsocket(conn)); #if TCL_MAJOR_VERSION >= 8 connid->notifier_channel = Tcl_MakeTcpClientChannel((ClientData) PQsocket(conn)); Tcl_RegisterChannel(NULL, connid->notifier_channel); #else connid->notifier_socket = -1; #endif #if TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION == 5 /* Original signature (only seen in Tcl 7.5) */ conn_chan = Tcl_CreateChannel(&Pg_ConnType, connid->id, NULL, NULL, (ClientData) connid); #else /* Tcl 7.6 and later use this */ conn_chan = Tcl_CreateChannel(&Pg_ConnType, connid->id, (ClientData) connid, TCL_READABLE | TCL_WRITABLE); #endif Tcl_SetChannelOption(interp, conn_chan, "-buffering", "line"); Tcl_SetResult(interp, connid->id, TCL_VOLATILE); Tcl_RegisterChannel(interp, conn_chan); }
/*----------------------------------------------------------------------------- * 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; }
/* * Create and register a new channel for the connection */ int PgSetConnectionId(Tcl_Interp *interp, PGconn *conn, char *chandle) { Tcl_Channel conn_chan; Tcl_Obj *nsstr; Pg_ConnectionId *connid; int i; CONST char *ns = ""; connid = (Pg_ConnectionId *) ckalloc(sizeof(Pg_ConnectionId)); connid->conn = conn; connid->res_count = 0; connid->res_last = -1; connid->res_max = RES_START; connid->res_hardmax = RES_HARD_MAX; connid->res_copy = -1; connid->res_copyStatus = RES_COPY_NONE; connid->results = (PGresult **)ckalloc(sizeof(PGresult *) * RES_START); connid->resultids = (Pg_resultid **)ckalloc(sizeof(Pg_resultid *) * RES_START); for (i = 0; i < RES_START; i++) { connid->results[i] = NULL; connid->resultids[i] = NULL; } connid->notify_list = NULL; connid->notifier_running = 0; connid->interp = interp; connid->nullValueString = NULL; nsstr = Tcl_NewStringObj("if {[namespace current] != \"::\"} {set k [namespace current]::}", -1); Tcl_EvalObjEx(interp, nsstr, 0); /* Tcl_Eval(interp, "if {[namespace current] != \"::\"} {\ set k [namespace current]::\ }"); */ ns = Tcl_GetStringResult(interp); Tcl_ResetResult(interp); if (chandle == NULL) { sprintf(connid->id, "%spgsql%d", ns, PQsocket(conn)); } else { sprintf(connid->id, "%s%s", ns, chandle); } conn_chan = Tcl_GetChannel(interp, connid->id, 0); if (conn_chan != NULL) { return 0; } connid->notifier_channel = Tcl_MakeTcpClientChannel((ClientData)(long)PQsocket(conn)); /* Code executing outside of any Tcl interpreter can call Tcl_RegisterChannel with interp as NULL, to indicate that it wishes to hold a reference to this channel. Subse- quently, the channel can be registered in a Tcl inter- preter and it will only be closed when the matching number of calls to Tcl_UnregisterChannel have been made. This allows code executing outside of any interpreter to safely hold a reference to a channel that is also registered in a Tcl interpreter. */ Tcl_RegisterChannel(NULL, connid->notifier_channel); conn_chan = Tcl_CreateChannel(&Pg_ConnType, connid->id, (ClientData) connid, TCL_READABLE | TCL_WRITABLE); Tcl_SetChannelOption(interp, conn_chan, "-buffering", "line"); Tcl_SetResult(interp, connid->id, TCL_VOLATILE); Tcl_RegisterChannel(interp, conn_chan); connid->cmd_token=Tcl_CreateObjCommand(interp, connid->id, PgConnCmd, (ClientData) connid, PgDelCmdHandle); 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; }
int main(int argc, char **argv) { bool sawParadynFlag = false; #if defined(os_windows) // initialize our use of the WinSock library InitSockets( __argv[0] ); #endif for( unsigned int i = 1; i < argc; i++ ) { if( strcmp(argv[i], "--debug" ) == 0 ) { xsynch_flag = true; #if !defined(i386_unknown_nt4_0) cout << "tableVisi at sigpause...pid=" << getpid() << endl; sigpause(0); #endif // !defined(i386_unknown_nt4_0) } else if( strcmp( argv[i], "--paradyn" ) == 0 ) { sawParadynFlag = true; } else { Tcl_Panic( "unrecognized argument seen", NULL ); } } if( !sawParadynFlag ) { ShowNoSoloVisiMessage( argv[0] ); } // Let Tcl know something about our executable (and do some filesystem- // specific initialization). // // NOTE: this is obligatory with modern versions of Tcl. Tcl_FindExecutable( argv[0] ); mainInterp = Tcl_CreateInterp(); assert(mainInterp); #if !defined(i386_unknown_nt4_0) if (xsynch_flag) { cout << "xsynching..." << endl; XSynchronize(Tk_Display(Tk_MainWindow(mainInterp)), 1); } #endif // !defined(i386_unknown_nt4_0) if (TCL_OK != Tcl_Init(mainInterp)) tclpanic(mainInterp, "Could not Tcl_Init"); // Set argv0 before we do any other Tk program initialization because // Tk takes the main window's class and instance name from argv0 // We set it to "paradyn" instead of "termwin" so that we can // set resources for all paradyn-related windows with the same root. Tcl_SetVar( mainInterp, "argv0", "paradyn", TCL_GLOBAL_ONLY ); if (TCL_OK != Tk_Init(mainInterp)) tclpanic(mainInterp, "Could not Tk_Init"); if (TCL_OK != Dg2_Init(mainInterp)) tclpanic(mainInterp, "Could not Dg2_Init"); PDSOCKET visi_sock = visi_Init(); if (visi_sock < 0) Tcl_Panic("failed to initialize w/ visi lib", NULL); Tcl_SetVar(mainInterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY); // Install our new tcl commands here: installTableVisiCommands(mainInterp); if (visi_RegistrationCallback(ADDMETRICSRESOURCES,Dg2AddMetricsCallback)!=0) Tcl_Panic("Dg2_Init() -- couldn't install ADDMETRICSRESOURCES callback", NULL); if (visi_RegistrationCallback(DATAVALUES, Dg2NewDataCallback) != 0) Tcl_Panic("Dg2_Init() -- couldn't install DATAVALUES callback", NULL); if (visi_RegistrationCallback(PARADYNEXITED, Dg2ParadynExitedCallback) != 0) panic("Dg2_Init() -- couldn't install PARADYNEXITED callback"); // if (visi_RegistrationCallback(PHASEDATA, Dg2PhaseDataCallback) != 0) // panic("Dg2_Init() -- couldn't install PHASEINFO callback"); // install a handler to notify us when there is data to be read Tcl_Channel visi_chan = Tcl_MakeTcpClientChannel((ClientData)(Address)(PDDESC)visi_sock); Tcl_CreateChannelHandler(visi_chan, TCL_READABLE, (Tcl_FileProc*)visiFdReadableHandler, 0); // Krishna's tcl2c stuff: extern int initialize_tcl_sources(Tcl_Interp *); if (TCL_OK != initialize_tcl_sources(mainInterp)) tclpanic(mainInterp, "tableVisi: could not initialize_tcl_sources"); //if (Tcl_EvalFile(mainInterp, "/p/paradyn/development/tamches/core/visiClients/tableVisi/tcl/tableVisi.tcl") != TCL_OK) // tclpanic(mainInterp, "could not open tableVisi.tcl"); pdLogo::install_fixed_logo("paradynLogo", logo_bits, logo_width, logo_height); tcl_cmd_installer createPdLogo(mainInterp, "makeLogo", pdLogo::makeLogoCommand, (ClientData)Tk_MainWindow(mainInterp)); myTclEval(mainInterp, "initializeTableVisi"); // Create our main data structure: theTableVisi = new tableVisi(mainInterp, Tk_NameToWindow(mainInterp, ".body", Tk_MainWindow(mainInterp)), "lightBlue", // line color "blue", // metric color "black", // metric units color "maroon3", // focus color "black", // cell color "gray", // background color "lightGray", // highlight background color 3 // initial # sig figs ); assert(theTableVisi); Tk_MainLoop(); // returns when all tk windows are closed delete theTableVisi; theTableVisi = NULL; return 0; }