static TclCallback *
NewCallback(Tcl_Interp *interp, char *proc, char *arg)
{
TclCallback *cbPtr;
char *argv[2];
argv[0] = proc;
argv[1] = arg;
cbPtr = ns_malloc(sizeof(TclCallback));
cbPtr->server = Ns_TclInterpServer(interp);
cbPtr->script = Tcl_Concat(arg ? 2 : 1, argv);
return cbPtr;
}
/* ARGSUSED */
int
Tcl_ConcatCmd(
void *dummy /* Not used. */
, Tcl_Interp *interp /* Current interpreter. */
, int argc /* Number of arguments. */
, unsigned char **argv /* Argument strings. */
)
{
if (argc == 1) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" arg ?arg ...?\"", 0);
return TCL_ERROR;
}
interp->result = Tcl_Concat (interp->pool, argc-1, argv+1);
interp->freeProc = (Tcl_FreeProc *) mem_free;
return TCL_OK;
}
static void dns_tcl_iporhostres(sockname_t *ip, char *hostn, int ok, void *other)
{
devent_tclinfo_t *tclinfo = (devent_tclinfo_t *) other;
Tcl_DString list;
Tcl_DStringInit(&list);
Tcl_DStringAppendElement(&list, tclinfo->proc);
Tcl_DStringAppendElement(&list, iptostr(&ip->addr.sa));
Tcl_DStringAppendElement(&list, hostn);
Tcl_DStringAppendElement(&list, ok ? "1" : "0");
if (tclinfo->paras) {
EGG_CONST char *argv[2];
char *output;
argv[0] = Tcl_DStringValue(&list);
argv[1] = tclinfo->paras;
output = Tcl_Concat(2, argv);
if (Tcl_Eval(interp, output) == TCL_ERROR) {
putlog(LOG_MISC, "*", DCC_TCLERROR, tclinfo->proc, tcl_resultstring());
Tcl_BackgroundError(interp);
}
Tcl_Free(output);
} else if (Tcl_Eval(interp, Tcl_DStringValue(&list)) == TCL_ERROR) {
putlog(LOG_MISC, "*", DCC_TCLERROR, tclinfo->proc, tcl_resultstring());
Tcl_BackgroundError(interp);
}
Tcl_DStringFree(&list);
nfree(tclinfo->proc);
if (tclinfo->paras)
nfree(tclinfo->paras);
nfree(tclinfo);
}
/* ARGSUSED */
int
Tcl_EvalCmd(
void *dummy /* Not used. */
, Tcl_Interp *interp /* Current interpreter. */
, int argc /* Number of arguments. */
, unsigned char **argv /* Argument strings. */
)
{
int result;
unsigned char *cmd;
if (argc < 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" arg ?arg ...?\"", 0);
return TCL_ERROR;
}
if (argc == 2) {
result = Tcl_Eval(interp, argv[1], 0, 0);
} else {
/*
* More than one argument: concatenate them together with spaces
* between, then evaluate the result.
*/
cmd = Tcl_Concat (interp->pool, argc-1, argv+1);
result = Tcl_Eval(interp, cmd, 0, 0);
mem_free(cmd);
}
if (result == TCL_ERROR) {
unsigned char msg[60];
snprintf(msg, sizeof (msg), "\n (\"eval\" body line %d)", interp->errorLine);
Tcl_AddErrorInfo(interp, msg);
}
return result;
}
int TclgrCmd (ClientData clientData, Tcl_Interp *interp, int argc,
const char *argv[])
{
if (argc == 1 || (argc == 2 && (!strcmp (argv[1], "help") ||
!strcmp (argv[1], "usage"))))
{
return Tcl_Eval (interp, "help tclgr");
}
if (!strcmp (argv[1], "syscommand"))
{
if (argc < 3)
{
interp->result = gr_command;
return TCL_OK;
}
else
{
strcpy (gr_command,argv[2]);
return TCL_OK;
}
}
if (!strcmp (argv[1], "open"))
{
int status;
int bufsize = 1000;
int argindex;
for (argindex = 2; argindex < argc; argindex++)
{
if (!strcmp (argv[argindex], "-buffersize"))
{
argindex++;
if (argindex < argc)
{
char dummy[512];
int count = sscanf (argv[argindex],
"%d %s", &bufsize, &dummy);
if (count == 1)
{
continue;
}
}
interp->result = "Ill-formed -buffersize argument";
return TCL_ERROR;
}
else
{
interp->result = "Invalid tclgr open arguments";
return TCL_ERROR;
}
}
if (terminated_by_user)
{
interp->result =
"ACE/gr session apparently terminated by user; use 'tclgr close' to reset";
return TCL_ERROR;
}
status = ACEgrOpen (bufsize, gr_command);
if (status)
{
if (status == -2)
{
interp->result =
"tclgr session already opened from this solar session";
}
else
{
interp->result = "Error returned from ACEgrOpen";
}
return TCL_ERROR;
}
return TCL_OK;
}
if (!strcmp (argv[1], "close"))
{
int status = ACEgrClose (terminated_by_user);
terminated_by_user = 0;
if (status)
{
interp->result = "Error returned from ACEgrClose";
return TCL_ERROR;
}
return TCL_OK;
}
if (terminated_by_user)
{
interp->result =
"ACE/gr session apparently terminated by user; use 'tclgr close' to reset";
return TCL_ERROR;
}
if (!strcmp (argv[1], "buffer"))
{
char *command = Tcl_Concat (argc-2, &argv[2]);
int status = ACEgrCommand (command);
if (status)
{
if (status == -2)
{
terminated_by_user = 1;
interp->result =
"ACE/gr session apparently terminated by user; use 'tclgr close' to reset";
return TCL_ERROR;
}
interp->result = "Error returned from ACEgrCommand";
return TCL_ERROR;
}
return TCL_OK;
}
if (!strcmp (argv[1], "send"))
{
char *command = Tcl_Concat (argc-2, &argv[2]);
int status = ACEgrCommand (command);
if (status)
{
interp->result = "Error returned from ACEgrCommand";
return TCL_ERROR;
}
status = ACEgrFlush ();
if (status)
{
if (status == -2)
{
terminated_by_user = 1;
interp->result =
"ACE/gr session apparently terminated by user; use 'tclgr close' to reset";
return TCL_ERROR;
}
interp->result = "Error returned from ACEgrFlush";
return TCL_ERROR;
}
return TCL_OK;
}
if (!strcmp (argv[1], "flush"))
{
int status = ACEgrFlush ();
if (status)
{
if (status == -2)
{
terminated_by_user = 1;
interp->result =
"ACE/gr session apparently terminated by user; use 'tclgr close' to reset";
return TCL_ERROR;
}
interp->result = "Error returned from ACEgrFlush";
return TCL_ERROR;
}
return TCL_OK;
}
interp->result = "Unrecognized tclgr command; see tclgr help";
return TCL_ERROR;
}
