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