00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017 #include "config.h"
00018
00019 #include "TclCommand.h"
00020 #include "HelpCommand.h"
00021 #include "DebugCommand.h"
00022 #include "LogCommand.h"
00023
00024 #include "debug/DebugUtils.h"
00025 #include "io/NetUtils.h"
00026 #include "thread/SpinLock.h"
00027 #include "util/StringBuffer.h"
00028 #include "util/InitSequencer.h"
00029
00030 extern "C" int Tclreadline_Init(Tcl_Interp* interp);
00031
00032 namespace oasys {
00033
00034
00035
00036
00037
00038
00039
00040 TclCommandInterp* TclCommandInterp::instance_;
00041 TclCommandList* TclCommandInterp::auto_reg_ = NULL;
00042
00043 #include "command-init-tcl.c"
00044
00045 TclCommandInterp::TclCommandInterp()
00046 : Logger("TclCommandInterp", "/command")
00047 {}
00048
00049 int
00050 TclCommandInterp::do_init(char* argv0, bool no_default_cmds)
00051 {
00052 interp_ = Tcl_CreateInterp();
00053 lock_ = new SpinLock();
00054 Tcl_Preserve(interp_);
00055
00056
00057
00058
00059 Tcl_FindExecutable(argv0);
00060
00061
00062
00063
00064 if (Tcl_Init(interp_) != TCL_OK) {
00065 StringBuffer err("initialization problem calling Tcl_Init: %s\n"
00066 "(this is not a fatal error, continuing initialization...)\n\n",
00067 interp_->result);
00068 log_multiline(LOG_WARN, err.c_str());
00069 }
00070
00071
00072 if (auto_reg_) {
00073 ASSERT(auto_reg_);
00074 while (!auto_reg_->empty()) {
00075 TclCommand* m = auto_reg_->front();
00076 auto_reg_->pop_front();
00077 reg(m);
00078 }
00079
00080 delete auto_reg_;
00081 auto_reg_ = NULL;
00082 }
00083
00084
00085 if (! no_default_cmds) {
00086 HelpCommand* help = new HelpCommand();
00087 reg(help);
00088
00089 LogCommand* log = new LogCommand();
00090 reg(log);
00091
00092 DebugCommand* debug = new DebugCommand();
00093 reg(debug);
00094 }
00095
00096
00097
00098 char* cmd = strdup(INIT_COMMAND);
00099 if (Tcl_Eval(interp_, cmd) != TCL_OK) {
00100 log_err("error in init commands: \"%s\"", interp_->result);
00101 return TCL_ERROR;
00102 }
00103 free(cmd);
00104
00105 return TCL_OK;
00106 }
00107
00108 TclCommandInterp::~TclCommandInterp()
00109 {
00110 log_notice("shutting down interpreter");
00111 TclCommandList::iterator iter;
00112 for (iter = commands_.begin();
00113 iter != commands_.end();
00114 ++iter)
00115 {
00116 log_debug("deleting %s command", (*iter)->name_.c_str());
00117 delete *iter;
00118 }
00119
00120 log_debug("all commands deleted");
00121
00122 commands_.clear();
00123
00124 Tcl_DeleteInterp(interp_);
00125 Tcl_Release(interp_);
00126
00127 delete lock_;
00128 }
00129
00130 void
00131 TclCommandInterp::shutdown()
00132 {
00133 delete instance_;
00134 instance_ = NULL;
00135 }
00136
00137 int
00138 TclCommandInterp::init(char* argv0, bool no_default_cmds)
00139 {
00140 ASSERT(instance_ == NULL);
00141 instance_ = new TclCommandInterp();
00142
00143 return instance_->do_init(argv0, no_default_cmds);
00144 }
00145
00146 int
00147 TclCommandInterp::exec_file(const char* file)
00148 {
00149 int err;
00150 ScopeLock l(lock_, "TclCommandInterp::exec_file");
00151
00152 log_debug("executing command file %s", file);
00153
00154 err = Tcl_EvalFile(interp_, (char*)file);
00155
00156 if (err != TCL_OK) {
00157 logf(LOG_ERR, "error: line %d: '%s':\n%s",
00158 interp_->errorLine, Tcl_GetStringResult(interp_),
00159 Tcl_GetVar(interp_, "errorInfo", TCL_GLOBAL_ONLY));
00160 }
00161
00162 return err;
00163 }
00164
00165 int
00166 TclCommandInterp::exec_command(const char* command)
00167 {
00168 int err;
00169 ScopeLock l(lock_, "TclCommandInterp::exec_command");
00170
00171
00172 if (command[0] == '\0')
00173 return TCL_OK;
00174
00175
00176
00177 char* buf = strdup(command);
00178
00179 log_debug("executing command '%s'", buf);
00180
00181 err = Tcl_Eval(interp_, buf);
00182
00183 free(buf);
00184
00185 if (err != TCL_OK) {
00186 logf(LOG_ERR, "error: line %d: '%s':\n%s",
00187 interp_->errorLine, Tcl_GetStringResult(interp_),
00188 Tcl_GetVar(interp_, "errorInfo", TCL_GLOBAL_ONLY));
00189 }
00190
00191 return err;
00192 }
00193
00194 void
00195 TclCommandInterp::command_server(const char* prompt,
00196 in_addr_t addr, u_int16_t port)
00197 {
00198 log_debug("starting command server on %s:%d", intoa(addr), port);
00199 StringBuffer cmd("command_server \"%s\" %s %d", prompt, intoa(addr), port);
00200
00201 if (Tcl_Eval(interp_, const_cast<char*>(cmd.c_str())) != TCL_OK) {
00202 log_err("tcl error starting command_server: \"%s\"",
00203 interp_->result);
00204 }
00205 }
00206
00207 void
00208 TclCommandInterp::command_loop(const char* prompt)
00209 {
00210 StringBuffer cmd("command_loop \"%s\"", prompt);
00211
00212 #if TCLREADLINE_ENABLED
00213 Tclreadline_Init(interp_);
00214 #endif
00215
00216 if (Tcl_Eval(interp_, const_cast<char*>(cmd.c_str())) != TCL_OK) {
00217 log_err("tcl error in command_loop: \"%s\"", interp_->result);
00218 }
00219 }
00220
00221 void
00222 TclCommandInterp::event_loop()
00223 {
00224 if (Tcl_Eval(interp_, "event_loop") != TCL_OK) {
00225 log_err("tcl error in event_loop: \"%s\"", interp_->result);
00226 }
00227 }
00228
00229 void
00230 TclCommandInterp::exit_event_loop()
00231 {
00232 if (Tcl_Eval(interp_, "exit_event_loop") != TCL_OK) {
00233 log_err("tcl error in event_loop: \"%s\"", interp_->result);
00234 }
00235 }
00236
00237 void
00238 TclCommandInterp::reg(TclCommand *command)
00239 {
00240 ScopeLock l(lock_, "TclCommandInterp::reg");
00241
00242 command->logf(LOG_DEBUG, "%s command registering", command->name());
00243
00244 Tcl_CmdInfo info;
00245 if (Tcl_GetCommandInfo(interp_, (char*)command->name(), &info) != 0) {
00246 log_warn("re-registering command %s over existing command",
00247 command->name());
00248 }
00249
00250 Tcl_CreateObjCommand(interp_,
00251 const_cast<char*>(command->name()),
00252 TclCommandInterp::tcl_cmd,
00253 (ClientData)command,
00254 NULL);
00255
00256 commands_.push_front(command);
00257 }
00258
00259 bool
00260 TclCommandInterp::lookup(const char* command, TclCommand** commandp)
00261 {
00262 Tcl_CmdInfo info;
00263
00264 if (Tcl_GetCommandInfo(interp_, (char*)command, &info) == 0) {
00265 log_debug("lookup tcl command %s: does not exist", command);
00266 return false;
00267 }
00268
00269 if (info.objProc == TclCommandInterp::tcl_cmd) {
00270 log_debug("lookup tcl command %s: exists and is TclCommand %p",
00271 command, info.clientData);
00272
00273 if (commandp)
00274 *commandp = (TclCommand*)info.objClientData;
00275
00276 } else {
00277 log_debug("lookup tcl command %s: exists but is not a TclCommand",
00278 command);
00279 }
00280
00281 return true;
00282 }
00283
00284 void
00285 TclCommandInterp::auto_reg(TclCommand *command)
00286 {
00287
00288
00289 ASSERT(instance_ == NULL);
00290
00291
00292
00293 if (!auto_reg_)
00294 auto_reg_ = new TclCommandList();
00295
00296 auto_reg_->push_back(command);
00297 }
00298
00299 void
00300 TclCommandInterp::reg_atexit(void(*fn)(void*), void* data)
00301 {
00302 ScopeLock l(lock_, "TclCommandInterp::reg_atexit");
00303 Tcl_CreateExitHandler(fn, data);
00304 }
00305
00306 int
00307 TclCommandInterp::tcl_cmd(ClientData client_data, Tcl_Interp* interp,
00308 int objc, Tcl_Obj* const* objv)
00309 {
00310 TclCommand* command = (TclCommand*)client_data;
00311
00312
00313 if (command->do_builtins_)
00314 {
00315 if (objc >= 2) {
00316 const char* cmd = Tcl_GetStringFromObj(objv[1], NULL);
00317 if (strcmp(cmd, "cmd_info") == 0) {
00318 return command->cmd_info(interp);
00319 }
00320
00321 if (strcmp(cmd, "set") == 0) {
00322 return command->cmd_set(objc, (Tcl_Obj**)objv, interp);
00323 }
00324 }
00325 }
00326
00327 return command->exec(objc, (Tcl_Obj**)objv, interp);
00328 }
00329
00330 void
00331 TclCommandInterp::set_result(const char* result)
00332 {
00333 Tcl_SetResult(interp_, (char*)result, TCL_VOLATILE);
00334 }
00335
00336 void
00337 TclCommandInterp::set_objresult(Tcl_Obj* obj)
00338 {
00339 Tcl_SetObjResult(interp_, obj);
00340 }
00341
00342 void
00343 TclCommandInterp::append_result(const char* result)
00344 {
00345 Tcl_AppendResult(interp_, (char*)result, NULL);
00346 }
00347
00348 void
00349 TclCommandInterp::resultf(const char* fmt, ...)
00350 {
00351 StringBuffer buf;
00352 STRINGBUFFER_VAPPENDF(buf, fmt);
00353 set_result(buf.c_str());
00354 }
00355
00356 void
00357 TclCommandInterp::append_resultf(const char* fmt, ...)
00358 {
00359 StringBuffer buf;
00360 STRINGBUFFER_VAPPENDF(buf, fmt);
00361 append_result(buf.c_str());
00362 }
00363
00364 void
00365 TclCommandInterp::wrong_num_args(int argc, const char** argv, int parsed,
00366 int min, int max)
00367 {
00368 set_result("wrong number of arguments to '");
00369 append_result(argv[0]);
00370
00371 for (int i = 1; i < parsed; ++i) {
00372 append_result(" ");
00373 append_result(argv[i]);
00374 }
00375 append_result("'");
00376
00377 if (max == min) {
00378 append_resultf(" expected %d, got %d", min, argc);
00379 } else if (max == INT_MAX) {
00380 append_resultf(" expected at least %d, got %d", min, argc);
00381 } else {
00382 append_resultf(" expected %d - %d, got %d", min, max, argc);
00383 }
00384 }
00385
00386 void
00387 TclCommandInterp::wrong_num_args(int objc, Tcl_Obj** objv, int parsed,
00388 int min, int max)
00389 {
00390 char* argv[objc];
00391 for (int i = 0; i < objc; ++i) {
00392 argv[i] = Tcl_GetStringFromObj(objv[i], NULL);
00393 }
00394 wrong_num_args(objc, (const char**)argv, parsed, min, max);
00395 }
00396
00397 const char*
00398 TclCommandInterp::get_result()
00399 {
00400 return Tcl_GetStringResult(interp_);
00401 }
00402
00403
00404
00405
00406
00407
00408 TclCommand::TclCommand(const char* name, const char* theNamespace)
00409 : Logger("TclCommand", "/command/%s", name),
00410 do_builtins_(true)
00411 {
00412
00413 if (theNamespace != 0) {
00414 name_ += theNamespace;
00415 name_ += "::";
00416 }
00417
00418 name_ += name;
00419 }
00420
00421 TclCommand::~TclCommand()
00422 {
00423 BindingTable::iterator iter;
00424 for (iter = bindings_.begin(); iter != bindings_.end(); ++iter) {
00425 delete iter->second;
00426 }
00427 bindings_.clear();
00428 }
00429
00430 int
00431 TclCommand::exec(int objc, Tcl_Obj** objv, Tcl_Interp* interp)
00432 {
00433
00434
00435 char* argv[objc];
00436
00437 for (int i = 0; i < objc; ++i) {
00438 argv[i] = Tcl_GetStringFromObj(objv[i], NULL);
00439 }
00440
00441 return exec(objc, (const char**) argv, interp);
00442 }
00443
00444 int
00445 TclCommand::exec(int argc, const char** argv, Tcl_Interp* interp)
00446 {
00447 (void)argc;
00448 (void)interp;
00449
00450 resultf("command %s unknown argument", argv[0]);
00451 return TCL_ERROR;
00452 }
00453
00454 void
00455 TclCommand::resultf(const char* fmt, ...)
00456 {
00457 StringBuffer buf;
00458 STRINGBUFFER_VAPPENDF(buf, fmt);
00459 TclCommandInterp::instance()->set_result(buf.c_str());
00460 }
00461
00462 void
00463 TclCommand::append_resultf(const char* fmt, ...)
00464 {
00465 StringBuffer buf;
00466 STRINGBUFFER_VAPPENDF(buf, fmt);
00467 TclCommandInterp::instance()->append_result(buf.c_str());
00468 }
00469
00470
00471 int
00472 TclCommand::cmd_info(Tcl_Interp* interp)
00473 {
00474 (void)interp;
00475
00476 StringBuffer buf;
00477
00478 for (BindingTable::iterator itr = bindings_.begin();
00479 itr != bindings_.end(); ++itr)
00480 {
00481 buf.appendf("%s ", (*itr).first.c_str());
00482 }
00483
00484 set_result(buf.c_str());
00485 return TCL_OK;
00486 }
00487
00488 int
00489 TclCommand::cmd_set(int objc, Tcl_Obj** objv, Tcl_Interp* interp)
00490 {
00491 (void)interp;
00492 ASSERT(objc >= 2);
00493
00494
00495 if (objc < 3 || objc > 4) {
00496 resultf("wrong number of args: expected 3-4, got %d", objc);
00497 return TCL_ERROR;
00498 }
00499
00500 const char* var = Tcl_GetStringFromObj(objv[2], NULL);
00501 int val_len = 0;
00502 const char* val = NULL;
00503 if (objc == 4) {
00504 val = Tcl_GetStringFromObj(objv[3], &val_len);
00505 }
00506
00507 BindingTable::iterator itr;
00508 itr = bindings_.find(var);
00509
00510 if (itr == bindings_.end()) {
00511 resultf("set: binding for %s does not exist", var);
00512 return TCL_ERROR;
00513 }
00514 Opt* opt = (*itr).second;
00515
00516
00517 if (val) {
00518 if (opt->set(val, val_len) != 0) {
00519 resultf("%s set %s: invalid value '%s'",
00520 Tcl_GetStringFromObj(objv[0], 0), var, val);
00521 return TCL_ERROR;
00522 }
00523 }
00524
00525 StaticStringBuffer<256> buf;
00526 opt->get(&buf);
00527 set_result(buf.c_str());
00528
00529 return TCL_OK;
00530 }
00531
00532 void
00533 TclCommand::bind_var(Opt* opt)
00534 {
00535 const char* name = opt->longopt_;
00536 if (bindings_.find(name) != bindings_.end()) {
00537 if (Log::initialized()) {
00538 log_warn("warning, binding for %s already exists", name);
00539 }
00540 }
00541
00542 bindings_[name] = opt;
00543
00544
00545 ASSERT(opt->desc_ != NULL && opt->desc_[0] != '\0');
00546
00547 StaticStringBuffer<256> subcmd("set %s", name);
00548 if (opt->valdesc_[0]) {
00549 subcmd.appendf(" <%s>", opt->valdesc_);
00550 }
00551 add_to_help(subcmd.c_str(), opt->desc_);
00552 }
00553
00554 void
00555 TclCommand::unbind(const char* name)
00556 {
00557 BindingTable::iterator iter = bindings_.find(name);
00558
00559 if (iter == bindings_.end()) {
00560 if (Log::initialized()) {
00561 log_warn("warning, binding for %s doesn't exist", name);
00562 }
00563 return;
00564 }
00565
00566 if (Log::initialized()) {
00567 log_debug("removing binding for %s", name);
00568 }
00569
00570 Opt* old = iter->second;
00571 bindings_.erase(iter);
00572
00573 delete old;
00574 }
00575
00576 }