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