static int
ConnCopy(Ns_Conn *conn, size_t tocopy, Ns_DString *dsPtr, Tcl_Channel chan,
FILE *fp, int fd)
{
int nwrote, avail;
int ncopy = (int) tocopy;
char *next;
if (NsConnContent(conn, &next, &avail) == NULL || avail < ncopy) {
return NS_ERROR;
}
while (ncopy > 0) {
if (dsPtr != NULL) {
Ns_DStringNAppend(dsPtr, next, ncopy);
nwrote = ncopy;
} else if (chan != NULL) {
nwrote = Tcl_Write(chan, next, ncopy);
} else if (fp != NULL) {
nwrote = fwrite(next, 1, (size_t) ncopy, fp);
if (ferror(fp)) {
nwrote = -1;
}
} else {
nwrote = write(fd, next, (size_t)ncopy);
}
if (nwrote < 0) {
return NS_ERROR;
}
ncopy -= nwrote;
next += nwrote;
NsConnSeek(conn, nwrote);
}
return NS_OK;
}
void
TnmSnmpDumpPDU(Tcl_Interp *interp, TnmSnmpPdu *pdu)
{
if (hexdump) {
int i, code, argc;
const char **argv;
char *name, *status;
char buffer[80];
Tcl_DString dst;
Tcl_Channel channel;
Tcl_DStringInit(&dst);
name = TnmGetTableValue(tnmSnmpPDUTable, (unsigned) pdu->type);
if (name == NULL) {
name = "(unknown PDU type)";
}
status = TnmGetTableValue(tnmSnmpErrorTable, (unsigned) pdu->errorStatus);
if (status == NULL) {
status = "(unknown error code)";
}
if (pdu->type == ASN1_SNMP_GETBULK) {
sprintf(buffer, "%s %d non-repeaters %d max-repetitions %d\n",
name, pdu->requestId,
pdu->errorStatus, pdu->errorIndex);
} else if (pdu->type == ASN1_SNMP_TRAP1) {
sprintf(buffer, "%s\n", name);
} else if (pdu->errorStatus == TNM_SNMP_NOERROR) {
sprintf(buffer, "%s %d %s\n", name, pdu->requestId, status);
} else {
sprintf(buffer, "%s %d %s at %d\n",
name, pdu->requestId, status, pdu->errorIndex);
}
Tcl_DStringAppend(&dst, buffer, -1);
code = Tcl_SplitList(interp, Tcl_DStringValue(&pdu->varbind),
&argc, &argv);
if (code == TCL_OK) {
for (i = 0; i < argc; i++) {
sprintf(buffer, "%4d.\t", i+1);
Tcl_DStringAppend(&dst, buffer, -1);
Tcl_DStringAppend(&dst, argv[i], -1);
Tcl_DStringAppend(&dst, "\n", -1);
}
ckfree((char *) argv);
}
Tcl_ResetResult(interp);
channel = Tcl_GetStdChannel(TCL_STDOUT);
if (channel) {
Tcl_Write(channel,
Tcl_DStringValue(&dst), Tcl_DStringLength(&dst));
}
Tcl_DStringFree(&dst);
}
}
void
TnmWriteMessage(const char *msg)
{
Tcl_Channel channel;
channel = Tcl_GetStdChannel(TCL_STDERR);
if (channel) {
Tcl_Write(channel, msg, -1);
}
}
static void
tclgd_channelPutchar (gdIOCtx * ctx, int a)
{
char b;
tclgd_channelIOCtx *tctx;
tctx = (tclgd_channelIOCtx *) ctx;
b = a;
if (Tcl_Write (tctx->channel, &b, 1) != 1) {
Tcl_Panic ("image write of 1 char didn't write 1 char, is your channel's translation set to binary?");
}
/* printf("tclgd_channelPutchar ctx %lx %d\n", ctx, a); */
}
static int
tclgd_channelPutbuf (gdIOCtx * ctx, const void *buf, int size)
{
int writeResult;
tclgd_channelIOCtx *tctx;
tctx = (tclgd_channelIOCtx *) ctx;
writeResult = Tcl_Write (tctx->channel, buf, size);
if (writeResult != size) {
Tcl_Panic ("image write of %d chars only did %d, is your channel's translation set to binary?", size, writeResult);
}
/* printf("tclgd_channelPutbuf ctx %lx buf %lx size %d result %d\n", ctx, buf, size, writeResult); */
return writeResult;
}
/* Print out just the variable that is modified */
void
FastTcpAgent::traceVar(TracedVar* v)
{
double curtime;
Scheduler& s = Scheduler::instance();
char wrk[500];
int n;
curtime = &s ? s.clock() : 0;
if (!strcmp(v->name(), "avgRTT_")
|| !strcmp(v->name(), "baseRTT_")
|| !strcmp(v->name(), "mi_threshold_")
)
sprintf(wrk,"%-8.5f %-2d %-2d %-2d %-2d %s %-6.3f",
curtime, addr(), port(), daddr(), dport(),
v->name(), double(*((TracedDouble*) v)));
else if (!strcmp(v->name(), "avg_cwnd_last_RTT_")
|| !strcmp(v->name(), "alpha_")
|| !strcmp(v->name(), "beta_")
|| !strcmp(v->name(), "high_accuracy_cwnd_" )
)
sprintf(wrk,"%-8.5f %-2d %-2d %-2d %-2d %s %d",
curtime, addr(), port(), daddr(), dport(),
v->name(), int(*((TracedInt*) v)));
else
{
TcpAgent::traceVar(v);
return;
}
n = strlen(wrk);
wrk[n] = '\n';
wrk[n+1] = 0;
if (channel_)
(void)Tcl_Write(channel_, wrk, n+1);
wrk[n] = 0;
return;
}
int TclTextInterp::evalString(const char *s) {
#if defined(VMD_NANOHUB)
if (Tcl_Eval(interp, s) != TCL_OK) {
#else
if (Tcl_RecordAndEval(interp, s, 0) != TCL_OK) {
#endif
// Don't print error message if there's nothing to show.
if (strlen(Tcl_GetStringResult(interp)))
msgErr << Tcl_GetStringResult(interp) << sendmsg;
return FALSE;
}
return TRUE;
}
void TclTextInterp::setString(const char *name, const char *val) {
if (interp)
Tcl_SetVar(interp, name, val,
TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
}
void TclTextInterp::setMap(const char *name, const char *key,
const char *val) {
if (interp)
Tcl_SetVar2(interp, name, key, val,
TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
}
// There's a fair amount of code duplication between doEvent and evalFile,
// maybe these could be combined somehow, say by having TclTextInterp keep
// track of its Tcl_Channel objects.
//
// Side note: Reading line-by-line gives different Tcl semantics than
// just calling Tcl_EvalFile. Shell commands (e.g., stty) are properly
// parsed when read line-by-line and passed to Tcl_RecordAndEval, but are
// unrecognized when contained in a file read by Tcl_EvalFile. I would
// consider this a bug.
int TclTextInterp::evalFile(const char *fname) {
Tcl_Channel inchannel = Tcl_OpenFileChannel(interp, fname, "r", 0644);
Tcl_Channel outchannel = Tcl_GetStdChannel(TCL_STDOUT);
if (inchannel == NULL) {
msgErr << "Error opening file " << fname << sendmsg;
msgErr << Tcl_GetStringResult(interp) << sendmsg;
return 1;
}
Tcl_Obj *cmdPtr = Tcl_NewObj();
Tcl_IncrRefCount(cmdPtr);
int length = 0;
while ((length = Tcl_GetsObj(inchannel, cmdPtr)) >= 0) {
Tcl_AppendToObj(cmdPtr, "\n", 1);
char *stringrep = Tcl_GetStringFromObj(cmdPtr, NULL);
if (!Tcl_CommandComplete(stringrep)) {
continue;
}
// check if "exit" was called
if (app->exitFlag) break;
#if defined(VMD_NANOHUB)
Tcl_EvalObjEx(interp, cmdPtr, 0);
#else
Tcl_RecordAndEvalObj(interp, cmdPtr, 0);
#endif
#if TCL_MINOR_VERSION >= 4
Tcl_DecrRefCount(cmdPtr);
cmdPtr = Tcl_NewObj();
Tcl_IncrRefCount(cmdPtr);
#else
// XXX this crashes Tcl 8.5.[46] with an internal panic
Tcl_SetObjLength(cmdPtr, 0);
#endif
// XXX this makes sure the display is updated
// after each line read from the file or pipe
// So, this is also where we'd optimise reading multiple
// lines at once
//
// In VR modes (CAVE, FreeVR, VR Juggler) the draw method will
// not be called from app->display_update(), so multiple lines
// of input could be combined in one frame, if possible
app->display_update();
Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
char *bytes = Tcl_GetStringFromObj(resultPtr, &length);
#if defined(VMDTKCON)
if (length > 0) {
vmdcon_append(VMDCON_ALWAYS, bytes,length);
vmdcon_append(VMDCON_ALWAYS, "\n", 1);
}
vmdcon_purge();
#else
if (length > 0) {
#if TCL_MINOR_VERSION >= 4
Tcl_WriteChars(outchannel, bytes, length);
Tcl_WriteChars(outchannel, "\n", 1);
#else
Tcl_Write(outchannel, bytes, length);
Tcl_Write(outchannel, "\n", 1);
#endif
}
Tcl_Flush(outchannel);
#endif
}
Tcl_Close(interp, inchannel);
Tcl_DecrRefCount(cmdPtr);
return 0;
}
void TclTextInterp::doEvent() {
if (!done_waiting())
return;
// no recursive calls to TclEvalObj; this prevents
// display update ui from messing up Tcl.
if (callLevel)
return;
Tcl_Channel inChannel = Tcl_GetStdChannel(TCL_STDIN);
Tcl_Channel outChannel = Tcl_GetStdChannel(TCL_STDOUT);
if (needPrompt && consoleisatty) {
#if TCL_MINOR_VERSION >= 4
if (gotPartial) {
Tcl_WriteChars(outChannel, "? ", -1);
} else {
Tcl_WriteChars(outChannel, VMD_CMD_PROMPT, -1);
}
#else
if (gotPartial) {
Tcl_Write(outChannel, "? ", -1);
} else {
Tcl_Write(outChannel, VMD_CMD_PROMPT, -1);
}
#endif
#if defined(VMDTKCON)
vmdcon_purge();
#endif
Tcl_Flush(outChannel);
needPrompt = 0;
}
#if defined(VMD_NANOHUB)
return;
#endif
//
// 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.
//
// 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.
//
if (ignorestdin)
return;
if (!vmd_check_stdin())
return;
//
// event loop based on tclMain.c
//
// According to the Tcl docs, GetsObj returns -1 on error or EOF.
int length = Tcl_GetsObj(inChannel, commandPtr);
if (length < 0) {
if (Tcl_Eof(inChannel)) {
// exit if we're not a tty, or if eofexit is set
if ((!consoleisatty) || app->get_eofexit())
app->VMDexit("", 0, 0);
} else {
msgErr << "Error reading Tcl input: " << Tcl_ErrnoMsg(Tcl_GetErrno())
<< sendmsg;
}
return;
}
needPrompt = 1;
// add the newline removed by Tcl_GetsObj
Tcl_AppendToObj(commandPtr, "\n", 1);
char *stringrep = Tcl_GetStringFromObj(commandPtr, NULL);
if (!Tcl_CommandComplete(stringrep)) {
gotPartial = 1;
return;
}
gotPartial = 0;
callLevel++;
#if defined(VMD_NANOHUB)
Tcl_EvalObjEx(interp, commandPtr, 0);
#else
Tcl_RecordAndEvalObj(interp, commandPtr, 0);
#endif
callLevel--;
#if TCL_MINOR_VERSION >= 4
Tcl_DecrRefCount(commandPtr);
commandPtr = Tcl_NewObj();
Tcl_IncrRefCount(commandPtr);
#else
// XXX this crashes Tcl 8.5.[46] with an internal panic
Tcl_SetObjLength(commandPtr, 0);
#endif
// if ok, send to stdout; if not, send to stderr
Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
char *bytes = Tcl_GetStringFromObj(resultPtr, &length);
#if defined(VMDTKCON)
if (length > 0) {
vmdcon_append(VMDCON_ALWAYS, bytes,length);
vmdcon_append(VMDCON_ALWAYS, "\n", 1);
}
vmdcon_purge();
#else
if (length > 0) {
#if TCL_MINOR_VERSION >= 4
Tcl_WriteChars(outChannel, bytes, length);
Tcl_WriteChars(outChannel, "\n", 1);
#else
Tcl_Write(outChannel, bytes, length);
Tcl_Write(outChannel, "\n", 1);
#endif
}
Tcl_Flush(outChannel);
#endif
}
size_t Tcldot_channel_writer(GVJ_t *job, const char *s, size_t len)
{
return Tcl_Write((Tcl_Channel)(job->output_file), s, len);
}
int
NsAdpFlush(NsInterp *itPtr, int stream)
{
Ns_Conn *conn;
Tcl_Interp *interp = itPtr->interp;
int len, wrote, result = TCL_ERROR, flags = itPtr->adp.flags;
char *buf;
/*
* Verify output context.
*/
if (itPtr->adp.conn == NULL && itPtr->adp.chan == NULL) {
Tcl_SetResult(interp, "no adp output context", TCL_STATIC);
return TCL_ERROR;
}
buf = itPtr->adp.output.string;
len = itPtr->adp.output.length;
/*
* If enabled, trim leading whitespace if no content has been sent yet.
*/
if ((flags & ADP_TRIM) && !(flags & ADP_FLUSHED)) {
while (len > 0 && isspace(UCHAR(*buf))) {
++buf;
--len;
}
}
/*
* Leave error messages if output is disabled or failed. Otherwise,
* send data if there's any to send or stream is 0, indicating this
* is the final flush call.
*/
Tcl_ResetResult(interp);
if (itPtr->adp.exception == ADP_ABORT) {
Tcl_SetResult(interp, "adp flush disabled: adp aborted", TCL_STATIC);
} else if (len == 0 && stream) {
result = TCL_OK;
} else {
if (itPtr->adp.chan != NULL) {
while (len > 0) {
wrote = Tcl_Write(itPtr->adp.chan, buf, len);
if (wrote < 0) {
Tcl_AppendResult(interp, "write failed: ",
Tcl_PosixError(interp), NULL);
break;
}
buf += wrote;
len -= wrote;
}
if (len == 0) {
result = TCL_OK;
}
} else if (NsTclGetConn(itPtr, &conn) == TCL_OK) {
if (conn->flags & NS_CONN_CLOSED) {
Tcl_SetResult(interp, "adp flush failed: connection closed",
TCL_STATIC);
} else {
if (flags & ADP_GZIP) {
Ns_ConnSetGzipFlag(conn, 1);
}
if (!(flags & ADP_FLUSHED) && (flags & ADP_EXPIRE)) {
Ns_ConnCondSetHeaders(conn, "Expires", "now");
}
if (Ns_ConnFlush(itPtr->conn, buf, len, stream) == NS_OK) {
result = TCL_OK;
} else {
Tcl_SetResult(interp,
"adp flush failed: connection flush error",
TCL_STATIC);
}
}
}
itPtr->adp.flags |= ADP_FLUSHED;
/*
* Raise an abort exception if autoabort is enabled.
*/
if (result != TCL_OK && (flags & ADP_AUTOABORT)) {
Tcl_AddErrorInfo(interp, "\n abort exception raised");
NsAdpLogError(itPtr);
itPtr->adp.exception = ADP_ABORT;
}
}
Tcl_DStringTrunc(&itPtr->adp.output, 0);
if (!stream) {
NsAdpReset(itPtr);
}
return result;
}
static int writestring(Tcl_Channel f, char *s)
{
int l = strlen(s);
return (Tcl_Write(f, s, l) == l);
}
int tclcommand_writemd(ClientData data, Tcl_Interp *interp,
int argc, char **argv)
{
static int end_num = -1;
char *row;
int p, i;
struct MDHeader header;
int tcl_file_mode;
Tcl_Channel channel;
if (argc < 3) {
#if defined(ELECTROSTATICS) && defined(DIPOLES)
Tcl_AppendResult(interp, "wrong # args: should be \"",
argv[0], " <file> ?posx|posy|posz|q|mx|my|mz|vx|vy|vz|fx|fy|fz|type?* ...\"",
(char *) NULL);
#else
#ifdef ELECTROSTATICS
Tcl_AppendResult(interp, "wrong # args: should be \"",
argv[0], " <file> ?posx|posy|posz|q|vx|vy|vz|fx|fy|fz|type?* ...\"",
(char *) NULL);
#endif
#ifdef DIPOLES
Tcl_AppendResult(interp, "wrong # args: should be \"",
argv[0], " <file> ?posx|posy|posz|mx|my|mz|vx|vy|vz|fx|fy|fz|type?* ...\"",
(char *) NULL);
#endif
#endif
return (TCL_ERROR);
}
if ((channel = Tcl_GetChannel(interp, argv[1], &tcl_file_mode)) == NULL)
return (TCL_ERROR);
if (!(tcl_file_mode & TCL_WRITABLE)) {
Tcl_AppendResult(interp, "\"", argv[1], "\" not writeable", (char *) NULL);
return (TCL_ERROR);
}
/* tune channel to binary translation, e.g. none */
Tcl_SetChannelOption(interp, channel, "-translation", "binary");
/* assemble rows */
argc -= 2;
argv += 2;
row = (char*)malloc(sizeof(char)*argc);
for (i = 0; i < argc; i++) {
if (!strncmp(*argv, "posx", strlen(*argv))) {
row[i] = POSX;
}
else if (!strncmp(*argv, "posy", strlen(*argv))) {
row[i] = POSY;
}
else if (!strncmp(*argv, "posz", strlen(*argv))) {
row[i] = POSZ;
}
#ifdef MASS
else if (!strncmp(*argv, "mass", strlen(*argv))) {
row[i] = MASSES;
}
#endif
else if (!strncmp(*argv, "q", strlen(*argv))) {
row[i] = Q;
}
#ifdef DIPOLES
else if (!strncmp(*argv, "mx", strlen(*argv))) {
row[i] = MX;
}
else if (!strncmp(*argv, "my", strlen(*argv))) {
row[i] = MY;
}
else if (!strncmp(*argv, "mz", strlen(*argv))) {
row[i] = MZ;
}
#endif
else if (!strncmp(*argv, "vx", strlen(*argv))) {
row[i] = VX;
}
else if (!strncmp(*argv, "vy", strlen(*argv))) {
row[i] = VY;
}
else if (!strncmp(*argv, "vz", strlen(*argv))) {
row[i] = VZ;
}
else if (!strncmp(*argv, "fx", strlen(*argv))) {
row[i] = FX;
}
else if (!strncmp(*argv, "fy", strlen(*argv))) {
row[i] = FY;
}
else if (!strncmp(*argv, "fz", strlen(*argv))) {
row[i] = FZ;
}
else if (!strncmp(*argv, "type", strlen(*argv))) {
row[i] = TYPE;
}
else {
Tcl_AppendResult(interp, "no particle data field \"", *argv, "\"?",
(char *) NULL);
free(row);
return (TCL_ERROR);
}
argv++;
}
if (!particle_node)
build_particle_node();
/* write header and row data */
memmove(header.magic, MDMAGIC, 4*sizeof(char));
header.n_rows = argc;
Tcl_Write(channel, (char *)&header, sizeof(header));
Tcl_Write(channel, row, header.n_rows*sizeof(char));
for (p = 0; p <= max_seen_particle; p++) {
Particle data;
if (get_particle_data(p, &data) == ES_OK) {
unfold_position(data.r.p, data.m.v, data.l.i);
/* write particle index */
Tcl_Write(channel, (char *)&p, sizeof(int));
for (i = 0; i < header.n_rows; i++) {
switch (row[i]) {
case POSX: Tcl_Write(channel, (char *)&data.r.p[0], sizeof(double)); break;
case POSY: Tcl_Write(channel, (char *)&data.r.p[1], sizeof(double)); break;
case POSZ: Tcl_Write(channel, (char *)&data.r.p[2], sizeof(double)); break;
case VX: Tcl_Write(channel, (char *)&data.m.v[0], sizeof(double)); break;
case VY: Tcl_Write(channel, (char *)&data.m.v[1], sizeof(double)); break;
case VZ: Tcl_Write(channel, (char *)&data.m.v[2], sizeof(double)); break;
case FX: Tcl_Write(channel, (char *)&data.f.f[0], sizeof(double)); break;
case FY: Tcl_Write(channel, (char *)&data.f.f[1], sizeof(double)); break;
case FZ: Tcl_Write(channel, (char *)&data.f.f[2], sizeof(double)); break;
#ifdef MASS
case MASSES: Tcl_Write(channel, (char *)&data.p.mass, sizeof(double)); break;
#endif
#ifdef ELECTROSTATICS
case Q: Tcl_Write(channel, (char *)&data.p.q, sizeof(double)); break;
#endif
#ifdef DIPOLES
case MX: Tcl_Write(channel, (char *)&data.r.dip[0], sizeof(double)); break;
case MY: Tcl_Write(channel, (char *)&data.r.dip[1], sizeof(double)); break;
case MZ: Tcl_Write(channel, (char *)&data.r.dip[2], sizeof(double)); break;
#endif
case TYPE: Tcl_Write(channel, (char *)&data.p.type, sizeof(int)); break;
}
}
free_particle(&data);
}
}
/* end marker */
Tcl_Write(channel, (char *)&end_num, sizeof(int));
free(row);
return TCL_OK;
}
static int
FileWritePPM(
Tcl_Interp *interp,
CONST char *fileName,
Tcl_Obj *format,
Tk_PhotoImageBlock *blockPtr)
{
Tcl_Channel chan;
int w, h, greenOffset, blueOffset, nBytes;
unsigned char *pixelPtr, *pixLinePtr;
char header[16 + TCL_INTEGER_SPACE * 2];
chan = Tcl_OpenFileChannel(interp, fileName, "w", 0666);
if (chan == NULL) {
return TCL_ERROR;
}
if (Tcl_SetChannelOption(interp, chan, "-translation", "binary")
!= TCL_OK) {
Tcl_Close(NULL, chan);
return TCL_ERROR;
}
if (Tcl_SetChannelOption(interp, chan, "-encoding", "binary")
!= TCL_OK) {
Tcl_Close(NULL, chan);
return TCL_ERROR;
}
sprintf(header, "P6\n%d %d\n255\n", blockPtr->width, blockPtr->height);
Tcl_Write(chan, header, -1);
pixLinePtr = blockPtr->pixelPtr + blockPtr->offset[0];
greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
blueOffset = blockPtr->offset[2] - blockPtr->offset[0];
if ((greenOffset == 1) && (blueOffset == 2) && (blockPtr->pixelSize == 3)
&& (blockPtr->pitch == (blockPtr->width * 3))) {
nBytes = blockPtr->height * blockPtr->pitch;
if (Tcl_Write(chan, (char *) pixLinePtr, nBytes) != nBytes) {
goto writeerror;
}
} else {
for (h = blockPtr->height; h > 0; h--) {
pixelPtr = pixLinePtr;
for (w = blockPtr->width; w > 0; w--) {
if ( Tcl_Write(chan,(char *)&pixelPtr[0], 1) == -1 ||
Tcl_Write(chan,(char *)&pixelPtr[greenOffset],1)==-1 ||
Tcl_Write(chan,(char *)&pixelPtr[blueOffset],1) ==-1) {
goto writeerror;
}
pixelPtr += blockPtr->pixelSize;
}
pixLinePtr += blockPtr->pitch;
}
}
if (Tcl_Close(NULL, chan) == 0) {
return TCL_OK;
}
chan = NULL;
writeerror:
Tcl_AppendResult(interp, "error writing \"", fileName, "\": ",
Tcl_PosixError(interp), NULL);
if (chan != NULL) {
Tcl_Close(NULL, chan);
}
return TCL_ERROR;
}
