1/*- 2 * See the file LICENSE for redistribution information. 3 * 4 * Copyright (c) 1999,2008 Oracle. All rights reserved. 5 * 6 * $Id: tcl_env.c,v 12.48 2008/02/01 18:27:17 sue Exp $ 7 */ 8 9#include "db_config.h" 10 11#include "db_int.h" 12#ifdef HAVE_SYSTEM_INCLUDE_FILES 13#include <tcl.h> 14#endif 15#include "dbinc/lock.h" 16#include "dbinc/txn.h" 17#include "dbinc/tcl_db.h" 18 19/* 20 * Prototypes for procedures defined later in this file: 21 */ 22static void _EnvInfoDelete __P((Tcl_Interp *, DBTCL_INFO *)); 23static int env_DbRemove __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *)); 24static int env_DbRename __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *)); 25static int env_GetFlags __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *)); 26static int env_GetOpenFlag 27 __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *)); 28static int env_GetLockDetect 29 __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *)); 30static int env_GetTimeout __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *)); 31static int env_GetVerbose __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *)); 32 33/* 34 * PUBLIC: int env_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*)); 35 * 36 * env_Cmd -- 37 * Implements the "env" command. 38 */ 39int 40env_Cmd(clientData, interp, objc, objv) 41 ClientData clientData; /* Env handle */ 42 Tcl_Interp *interp; /* Interpreter */ 43 int objc; /* How many arguments? */ 44 Tcl_Obj *CONST objv[]; /* The argument objects */ 45{ 46 static const char *envcmds[] = { 47#ifdef CONFIG_TEST 48 "attributes", 49 "errfile", 50 "errpfx", 51 "event", 52 "id_reset", 53 "lock_detect", 54 "lock_id", 55 "lock_id_free", 56 "lock_id_set", 57 "lock_get", 58 "lock_stat", 59 "lock_timeout", 60 "lock_vec", 61 "log_archive", 62 "log_compare", 63 "log_config", 64 "log_cursor", 65 "log_file", 66 "log_flush", 67 "log_get", 68 "log_get_config", 69 "log_put", 70 "log_stat", 71 "lsn_reset", 72 "mpool", 73 "mpool_stat", 74 "mpool_sync", 75 "mpool_trickle", 76 "rep_config", 77 "rep_elect", 78 "rep_flush", 79 "rep_get_clockskew", 80 "rep_get_config", 81 "rep_get_limit", 82 "rep_get_nsites", 83 "rep_get_request", 84 "rep_get_timeout", 85 "rep_lease", 86 "rep_limit", 87 "rep_process_message", 88 "rep_request", 89 "rep_start", 90 "rep_stat", 91 "rep_sync", 92 "rep_transport", 93 "repmgr", 94 "repmgr_stat", 95 "rpcid", 96 "set_flags", 97 "test", 98 "txn_id_set", 99 "txn_recover", 100 "txn_stat", 101 "txn_timeout", 102 "verbose", 103#endif 104 "cdsgroup", 105 "close", 106 "dbremove", 107 "dbrename", 108 "get_cachesize", 109 "get_cache_max", 110 "get_data_dirs", 111 "get_encrypt_flags", 112 "get_errpfx", 113 "get_flags", 114 "get_home", 115 "get_lg_bsize", 116 "get_lg_dir", 117 "get_lg_filemode", 118 "get_lg_max", 119 "get_lg_regionmax", 120 "get_lk_detect", 121 "get_lk_max_lockers", 122 "get_lk_max_locks", 123 "get_lk_max_objects", 124 "get_mp_max_openfd", 125 "get_mp_max_write", 126 "get_mp_mmapsize", 127 "get_open_flags", 128 "get_shm_key", 129 "get_tas_spins", 130 "get_timeout", 131 "get_tmp_dir", 132 "get_tx_max", 133 "get_tx_timestamp", 134 "get_verbose", 135 "resize_cache", 136 "set_data_dir", 137 "txn", 138 "txn_checkpoint", 139 NULL 140 }; 141 enum envcmds { 142#ifdef CONFIG_TEST 143 ENVATTR, 144 ENVERRFILE, 145 ENVERRPFX, 146 ENVEVENT, 147 ENVIDRESET, 148 ENVLKDETECT, 149 ENVLKID, 150 ENVLKFREEID, 151 ENVLKSETID, 152 ENVLKGET, 153 ENVLKSTAT, 154 ENVLKTIMEOUT, 155 ENVLKVEC, 156 ENVLOGARCH, 157 ENVLOGCMP, 158 ENVLOGCONFIG, 159 ENVLOGCURSOR, 160 ENVLOGFILE, 161 ENVLOGFLUSH, 162 ENVLOGGET, 163 ENVLOGGETCONFIG, 164 ENVLOGPUT, 165 ENVLOGSTAT, 166 ENVLSNRESET, 167 ENVMP, 168 ENVMPSTAT, 169 ENVMPSYNC, 170 ENVTRICKLE, 171 ENVREPCONFIG, 172 ENVREPELECT, 173 ENVREPFLUSH, 174 ENVREPGETCLOCKSKEW, 175 ENVREPGETCONFIG, 176 ENVREPGETLIMIT, 177 ENVREPGETNSITES, 178 ENVREPGETREQUEST, 179 ENVREPGETTIMEOUT, 180 ENVREPLEASE, 181 ENVREPLIMIT, 182 ENVREPPROCMESS, 183 ENVREPREQUEST, 184 ENVREPSTART, 185 ENVREPSTAT, 186 ENVREPSYNC, 187 ENVREPTRANSPORT, 188 ENVREPMGR, 189 ENVREPMGRSTAT, 190 ENVRPCID, 191 ENVSETFLAGS, 192 ENVTEST, 193 ENVTXNSETID, 194 ENVTXNRECOVER, 195 ENVTXNSTAT, 196 ENVTXNTIMEOUT, 197 ENVVERB, 198#endif 199 ENVCDSGROUP, 200 ENVCLOSE, 201 ENVDBREMOVE, 202 ENVDBRENAME, 203 ENVGETCACHESIZE, 204 ENVGETCACHEMAX, 205 ENVGETDATADIRS, 206 ENVGETENCRYPTFLAGS, 207 ENVGETERRPFX, 208 ENVGETFLAGS, 209 ENVGETHOME, 210 ENVGETLGBSIZE, 211 ENVGETLGDIR, 212 ENVGETLGFILEMODE, 213 ENVGETLGMAX, 214 ENVGETLGREGIONMAX, 215 ENVGETLKDETECT, 216 ENVGETLKMAXLOCKERS, 217 ENVGETLKMAXLOCKS, 218 ENVGETLKMAXOBJECTS, 219 ENVGETMPMAXOPENFD, 220 ENVGETMPMAXWRITE, 221 ENVGETMPMMAPSIZE, 222 ENVGETOPENFLAG, 223 ENVGETSHMKEY, 224 ENVGETTASSPINS, 225 ENVGETTIMEOUT, 226 ENVGETTMPDIR, 227 ENVGETTXMAX, 228 ENVGETTXTIMESTAMP, 229 ENVGETVERBOSE, 230 ENVRESIZECACHE, 231 ENVSETDATADIR, 232 ENVTXN, 233 ENVTXNCKP 234 }; 235 DBTCL_INFO *envip; 236 DB_ENV *dbenv; 237 Tcl_Obj **listobjv, *myobjv[3], *res; 238 db_timeout_t timeout; 239 size_t size; 240 time_t timeval; 241 u_int32_t bytes, gbytes, value; 242 long shm_key; 243 int cmdindex, i, intvalue, listobjc, ncache, result, ret; 244 const char *strval, **dirs; 245 char *strarg, newname[MSG_SIZE]; 246#ifdef CONFIG_TEST 247 DBTCL_INFO *logcip; 248 DB_LOGC *logc; 249 u_int32_t lockid; 250 long newval, otherval; 251#endif 252 253 Tcl_ResetResult(interp); 254 dbenv = (DB_ENV *)clientData; 255 envip = _PtrToInfo((void *)dbenv); 256 result = TCL_OK; 257 memset(newname, 0, MSG_SIZE); 258 259 if (objc <= 1) { 260 Tcl_WrongNumArgs(interp, 1, objv, "command cmdargs"); 261 return (TCL_ERROR); 262 } 263 if (dbenv == NULL) { 264 Tcl_SetResult(interp, "NULL env pointer", TCL_STATIC); 265 return (TCL_ERROR); 266 } 267 if (envip == NULL) { 268 Tcl_SetResult(interp, "NULL env info pointer", TCL_STATIC); 269 return (TCL_ERROR); 270 } 271 272 /* 273 * Get the command name index from the object based on the berkdbcmds 274 * defined above. 275 */ 276 if (Tcl_GetIndexFromObj(interp, objv[1], envcmds, "command", 277 TCL_EXACT, &cmdindex) != TCL_OK) 278 return (IS_HELP(objv[1])); 279 res = NULL; 280 switch ((enum envcmds)cmdindex) { 281#ifdef CONFIG_TEST 282 case ENVEVENT: 283 /* 284 * Two args for this. Error if different. 285 */ 286 if (objc != 3) { 287 Tcl_WrongNumArgs(interp, 2, objv, NULL); 288 return (TCL_ERROR); 289 } 290 result = tcl_EventNotify(interp, dbenv, objv[2], envip); 291 break; 292 case ENVIDRESET: 293 result = tcl_EnvIdReset(interp, objc, objv, dbenv); 294 break; 295 case ENVLSNRESET: 296 result = tcl_EnvLsnReset(interp, objc, objv, dbenv); 297 break; 298 case ENVLKDETECT: 299 result = tcl_LockDetect(interp, objc, objv, dbenv); 300 break; 301 case ENVLKSTAT: 302 result = tcl_LockStat(interp, objc, objv, dbenv); 303 break; 304 case ENVLKTIMEOUT: 305 result = tcl_LockTimeout(interp, objc, objv, dbenv); 306 break; 307 case ENVLKID: 308 /* 309 * No args for this. Error if there are some. 310 */ 311 if (objc > 2) { 312 Tcl_WrongNumArgs(interp, 2, objv, NULL); 313 return (TCL_ERROR); 314 } 315 _debug_check(); 316 ret = dbenv->lock_id(dbenv, &lockid); 317 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 318 "lock_id"); 319 if (result == TCL_OK) 320 res = Tcl_NewWideIntObj((Tcl_WideInt)lockid); 321 break; 322 case ENVLKFREEID: 323 if (objc != 3) { 324 Tcl_WrongNumArgs(interp, 3, objv, NULL); 325 return (TCL_ERROR); 326 } 327 result = Tcl_GetLongFromObj(interp, objv[2], &newval); 328 if (result != TCL_OK) 329 return (result); 330 ret = dbenv->lock_id_free(dbenv, (u_int32_t)newval); 331 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 332 "lock id_free"); 333 break; 334 case ENVLKSETID: 335 if (objc != 4) { 336 Tcl_WrongNumArgs(interp, 4, objv, "current max"); 337 return (TCL_ERROR); 338 } 339 result = Tcl_GetLongFromObj(interp, objv[2], &newval); 340 if (result != TCL_OK) 341 return (result); 342 result = Tcl_GetLongFromObj(interp, objv[3], &otherval); 343 if (result != TCL_OK) 344 return (result); 345 ret = __lock_id_set(dbenv->env, 346 (u_int32_t)newval, (u_int32_t)otherval); 347 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 348 "lock id_free"); 349 break; 350 case ENVLKGET: 351 result = tcl_LockGet(interp, objc, objv, dbenv); 352 break; 353 case ENVLKVEC: 354 result = tcl_LockVec(interp, objc, objv, dbenv); 355 break; 356 case ENVLOGARCH: 357 result = tcl_LogArchive(interp, objc, objv, dbenv); 358 break; 359 case ENVLOGCMP: 360 result = tcl_LogCompare(interp, objc, objv); 361 break; 362 case ENVLOGCONFIG: 363 /* 364 * Two args for this. Error if different. 365 */ 366 if (objc != 3) { 367 Tcl_WrongNumArgs(interp, 2, objv, NULL); 368 return (TCL_ERROR); 369 } 370 result = tcl_LogConfig(interp, dbenv, objv[2]); 371 break; 372 case ENVLOGCURSOR: 373 snprintf(newname, sizeof(newname), 374 "%s.logc%d", envip->i_name, envip->i_envlogcid); 375 logcip = _NewInfo(interp, NULL, newname, I_LOGC); 376 if (logcip != NULL) { 377 ret = dbenv->log_cursor(dbenv, &logc, 0); 378 if (ret == 0) { 379 result = TCL_OK; 380 envip->i_envlogcid++; 381 /* 382 * We do NOT want to set i_parent to 383 * envip here because log cursors are 384 * not "tied" to the env. That is, they 385 * are NOT closed if the env is closed. 386 */ 387 (void)Tcl_CreateObjCommand(interp, newname, 388 (Tcl_ObjCmdProc *)logc_Cmd, 389 (ClientData)logc, NULL); 390 res = NewStringObj(newname, strlen(newname)); 391 _SetInfoData(logcip, logc); 392 } else { 393 _DeleteInfo(logcip); 394 result = _ErrorSetup(interp, ret, "log cursor"); 395 } 396 } else { 397 Tcl_SetResult(interp, 398 "Could not set up info", TCL_STATIC); 399 result = TCL_ERROR; 400 } 401 break; 402 case ENVLOGFILE: 403 result = tcl_LogFile(interp, objc, objv, dbenv); 404 break; 405 case ENVLOGFLUSH: 406 result = tcl_LogFlush(interp, objc, objv, dbenv); 407 break; 408 case ENVLOGGET: 409 result = tcl_LogGet(interp, objc, objv, dbenv); 410 break; 411 case ENVLOGGETCONFIG: 412 /* 413 * Two args for this. Error if different. 414 */ 415 if (objc != 3) { 416 Tcl_WrongNumArgs(interp, 2, objv, NULL); 417 return (TCL_ERROR); 418 } 419 result = tcl_LogGetConfig(interp, dbenv, objv[2]); 420 break; 421 case ENVLOGPUT: 422 result = tcl_LogPut(interp, objc, objv, dbenv); 423 break; 424 case ENVLOGSTAT: 425 result = tcl_LogStat(interp, objc, objv, dbenv); 426 break; 427 case ENVMPSTAT: 428 result = tcl_MpStat(interp, objc, objv, dbenv); 429 break; 430 case ENVMPSYNC: 431 result = tcl_MpSync(interp, objc, objv, dbenv); 432 break; 433 case ENVTRICKLE: 434 result = tcl_MpTrickle(interp, objc, objv, dbenv); 435 break; 436 case ENVMP: 437 result = tcl_Mp(interp, objc, objv, dbenv, envip); 438 break; 439 case ENVREPCONFIG: 440 /* 441 * Two args for this. Error if different. 442 */ 443 if (objc != 3) { 444 Tcl_WrongNumArgs(interp, 2, objv, NULL); 445 return (TCL_ERROR); 446 } 447 result = tcl_RepConfig(interp, dbenv, objv[2]); 448 break; 449 case ENVREPELECT: 450 result = tcl_RepElect(interp, objc, objv, dbenv); 451 break; 452 case ENVREPFLUSH: 453 result = tcl_RepFlush(interp, objc, objv, dbenv); 454 break; 455 case ENVREPGETCLOCKSKEW: 456 result = tcl_RepGetTwo(interp, dbenv, DBTCL_GETCLOCK); 457 break; 458 case ENVREPGETCONFIG: 459 /* 460 * Two args for this. Error if different. 461 */ 462 if (objc != 3) { 463 Tcl_WrongNumArgs(interp, 2, objv, NULL); 464 return (TCL_ERROR); 465 } 466 result = tcl_RepGetConfig(interp, dbenv, objv[2]); 467 break; 468 case ENVREPGETLIMIT: 469 result = tcl_RepGetTwo(interp, dbenv, DBTCL_GETLIMIT); 470 break; 471 case ENVREPGETNSITES: 472 if (objc != 2) { 473 Tcl_WrongNumArgs(interp, 1, objv, NULL); 474 return (TCL_ERROR); 475 } 476 ret = dbenv->rep_get_nsites(dbenv, &value); 477 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 478 "env rep_get_nsites")) == TCL_OK) 479 res = Tcl_NewLongObj((long)value); 480 break; 481 case ENVREPGETREQUEST: 482 result = tcl_RepGetTwo(interp, dbenv, DBTCL_GETREQ); 483 break; 484 case ENVREPGETTIMEOUT: 485 /* 486 * Two args for this. Error if different. 487 */ 488 if (objc != 3) { 489 Tcl_WrongNumArgs(interp, 2, objv, NULL); 490 return (TCL_ERROR); 491 } 492 result = tcl_RepGetTimeout(interp, dbenv, objv[2]); 493 break; 494 case ENVREPLEASE: 495 if (objc != 3) { 496 Tcl_WrongNumArgs(interp, 2, objv, NULL); 497 return (TCL_ERROR); 498 } 499 result = Tcl_ListObjGetElements(interp, objv[2], 500 &listobjc, &listobjv); 501 if (result == TCL_OK) 502 result = tcl_RepLease(interp, 503 listobjc, listobjv, dbenv); 504 break; 505 case ENVREPLIMIT: 506 result = tcl_RepLimit(interp, objc, objv, dbenv); 507 break; 508 case ENVREPPROCMESS: 509 result = tcl_RepProcessMessage(interp, objc, objv, dbenv); 510 break; 511 case ENVREPREQUEST: 512 result = tcl_RepRequest(interp, objc, objv, dbenv); 513 break; 514 case ENVREPSTART: 515 result = tcl_RepStart(interp, objc, objv, dbenv); 516 break; 517 case ENVREPSTAT: 518 result = tcl_RepStat(interp, objc, objv, dbenv); 519 break; 520 case ENVREPSYNC: 521 result = tcl_RepSync(interp, objc, objv, dbenv); 522 break; 523 case ENVREPTRANSPORT: 524 if (objc != 3) { 525 Tcl_WrongNumArgs(interp, 2, objv, NULL); 526 return (TCL_ERROR); 527 } 528 result = Tcl_ListObjGetElements(interp, objv[2], 529 &listobjc, &listobjv); 530 if (result == TCL_OK) 531 result = tcl_RepTransport(interp, 532 listobjc, listobjv, dbenv, envip); 533 break; 534 case ENVREPMGR: 535 result = tcl_RepMgr(interp, objc, objv, dbenv); 536 break; 537 case ENVREPMGRSTAT: 538 result = tcl_RepMgrStat(interp, objc, objv, dbenv); 539 break; 540 case ENVRPCID: 541 /* 542 * No args for this. Error if there are some. 543 */ 544 if (objc > 2) { 545 Tcl_WrongNumArgs(interp, 2, objv, NULL); 546 return (TCL_ERROR); 547 } 548 /* 549 * !!! Retrieve the client ID from the dbp handle directly. 550 * This is for testing purposes only. It is BDB-private data. 551 */ 552 res = Tcl_NewLongObj((long)dbenv->cl_id); 553 break; 554 case ENVTXNSETID: 555 if (objc != 4) { 556 Tcl_WrongNumArgs(interp, 4, objv, "current max"); 557 return (TCL_ERROR); 558 } 559 result = Tcl_GetLongFromObj(interp, objv[2], &newval); 560 if (result != TCL_OK) 561 return (result); 562 result = Tcl_GetLongFromObj(interp, objv[3], &otherval); 563 if (result != TCL_OK) 564 return (result); 565 ret = __txn_id_set(dbenv->env, 566 (u_int32_t)newval, (u_int32_t)otherval); 567 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 568 "txn setid"); 569 break; 570 case ENVTXNRECOVER: 571 result = tcl_TxnRecover(interp, objc, objv, dbenv, envip); 572 break; 573 case ENVTXNSTAT: 574 result = tcl_TxnStat(interp, objc, objv, dbenv); 575 break; 576 case ENVTXNTIMEOUT: 577 result = tcl_TxnTimeout(interp, objc, objv, dbenv); 578 break; 579 case ENVATTR: 580 result = tcl_EnvAttr(interp, objc, objv, dbenv); 581 break; 582 case ENVERRFILE: 583 /* 584 * One args for this. Error if different. 585 */ 586 if (objc != 3) { 587 Tcl_WrongNumArgs(interp, 2, objv, "errfile"); 588 return (TCL_ERROR); 589 } 590 strarg = Tcl_GetStringFromObj(objv[2], NULL); 591 tcl_EnvSetErrfile(interp, dbenv, envip, strarg); 592 result = TCL_OK; 593 break; 594 case ENVERRPFX: 595 /* 596 * One args for this. Error if different. 597 */ 598 if (objc != 3) { 599 Tcl_WrongNumArgs(interp, 2, objv, "pfx"); 600 return (TCL_ERROR); 601 } 602 strarg = Tcl_GetStringFromObj(objv[2], NULL); 603 result = tcl_EnvSetErrpfx(interp, dbenv, envip, strarg); 604 break; 605 case ENVSETFLAGS: 606 /* 607 * Two args for this. Error if different. 608 */ 609 if (objc != 4) { 610 Tcl_WrongNumArgs(interp, 2, objv, "which on|off"); 611 return (TCL_ERROR); 612 } 613 result = tcl_EnvSetFlags(interp, dbenv, objv[2], objv[3]); 614 break; 615 case ENVTEST: 616 result = tcl_EnvTest(interp, objc, objv, dbenv); 617 break; 618 case ENVVERB: 619 /* 620 * Two args for this. Error if different. 621 */ 622 if (objc != 4) { 623 Tcl_WrongNumArgs(interp, 2, objv, NULL); 624 return (TCL_ERROR); 625 } 626 result = tcl_EnvVerbose(interp, dbenv, objv[2], objv[3]); 627 break; 628#endif 629 case ENVCDSGROUP: 630 result = tcl_CDSGroup(interp, objc, objv, dbenv, envip); 631 break; 632 case ENVCLOSE: 633 /* 634 * No args for this. Error if there are some. 635 */ 636 if (objc > 2) { 637 Tcl_WrongNumArgs(interp, 2, objv, NULL); 638 return (TCL_ERROR); 639 } 640 /* 641 * Any transactions will be aborted, and an mpools 642 * closed automatically. We must delete any txn 643 * and mp widgets we have here too for this env. 644 * NOTE: envip is freed when we come back from 645 * this function. Set it to NULL to make sure no 646 * one tries to use it later. 647 */ 648 _debug_check(); 649 ret = dbenv->close(dbenv, 0); 650 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 651 "env close"); 652 _EnvInfoDelete(interp, envip); 653 envip = NULL; 654 break; 655 case ENVDBREMOVE: 656 result = env_DbRemove(interp, objc, objv, dbenv); 657 break; 658 case ENVDBRENAME: 659 result = env_DbRename(interp, objc, objv, dbenv); 660 break; 661 case ENVGETCACHESIZE: 662 if (objc != 2) { 663 Tcl_WrongNumArgs(interp, 1, objv, NULL); 664 return (TCL_ERROR); 665 } 666 ret = dbenv->get_cachesize(dbenv, &gbytes, &bytes, &ncache); 667 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 668 "env get_cachesize")) == TCL_OK) { 669 myobjv[0] = Tcl_NewLongObj((long)gbytes); 670 myobjv[1] = Tcl_NewLongObj((long)bytes); 671 myobjv[2] = Tcl_NewLongObj((long)ncache); 672 res = Tcl_NewListObj(3, myobjv); 673 } 674 break; 675 case ENVGETCACHEMAX: 676 if (objc != 2) { 677 Tcl_WrongNumArgs(interp, 1, objv, NULL); 678 return (TCL_ERROR); 679 } 680 ret = dbenv->get_cache_max(dbenv, &gbytes, &bytes); 681 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 682 "env get_cache_max")) == TCL_OK) { 683 myobjv[0] = Tcl_NewLongObj((long)gbytes); 684 myobjv[1] = Tcl_NewLongObj((long)bytes); 685 res = Tcl_NewListObj(2, myobjv); 686 } 687 break; 688 case ENVGETDATADIRS: 689 if (objc != 2) { 690 Tcl_WrongNumArgs(interp, 1, objv, NULL); 691 return (TCL_ERROR); 692 } 693 ret = dbenv->get_data_dirs(dbenv, &dirs); 694 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 695 "env get_data_dirs")) == TCL_OK) { 696 res = Tcl_NewListObj(0, NULL); 697 for (i = 0; result == TCL_OK && dirs[i] != NULL; i++) 698 result = Tcl_ListObjAppendElement(interp, res, 699 NewStringObj(dirs[i], strlen(dirs[i]))); 700 } 701 break; 702 case ENVGETENCRYPTFLAGS: 703 result = tcl_EnvGetEncryptFlags(interp, objc, objv, dbenv); 704 break; 705 case ENVGETERRPFX: 706 if (objc != 2) { 707 Tcl_WrongNumArgs(interp, 1, objv, NULL); 708 return (TCL_ERROR); 709 } 710 dbenv->get_errpfx(dbenv, &strval); 711 res = NewStringObj(strval, strlen(strval)); 712 break; 713 case ENVGETFLAGS: 714 result = env_GetFlags(interp, objc, objv, dbenv); 715 break; 716 case ENVGETHOME: 717 if (objc != 2) { 718 Tcl_WrongNumArgs(interp, 1, objv, NULL); 719 return (TCL_ERROR); 720 } 721 ret = dbenv->get_home(dbenv, &strval); 722 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 723 "env get_home")) == TCL_OK) 724 res = NewStringObj(strval, strlen(strval)); 725 break; 726 case ENVGETLGBSIZE: 727 if (objc != 2) { 728 Tcl_WrongNumArgs(interp, 1, objv, NULL); 729 return (TCL_ERROR); 730 } 731 ret = dbenv->get_lg_bsize(dbenv, &value); 732 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 733 "env get_lg_bsize")) == TCL_OK) 734 res = Tcl_NewLongObj((long)value); 735 break; 736 case ENVGETLGDIR: 737 if (objc != 2) { 738 Tcl_WrongNumArgs(interp, 1, objv, NULL); 739 return (TCL_ERROR); 740 } 741 ret = dbenv->get_lg_dir(dbenv, &strval); 742 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 743 "env get_lg_dir")) == TCL_OK) 744 res = NewStringObj(strval, strlen(strval)); 745 break; 746 case ENVGETLGFILEMODE: 747 if (objc != 2) { 748 Tcl_WrongNumArgs(interp, 1, objv, NULL); 749 return (TCL_ERROR); 750 } 751 ret = dbenv->get_lg_filemode(dbenv, &intvalue); 752 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 753 "env get_lg_filemode")) == TCL_OK) 754 res = Tcl_NewLongObj((long)intvalue); 755 break; 756 case ENVGETLGMAX: 757 if (objc != 2) { 758 Tcl_WrongNumArgs(interp, 1, objv, NULL); 759 return (TCL_ERROR); 760 } 761 ret = dbenv->get_lg_max(dbenv, &value); 762 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 763 "env get_lg_max")) == TCL_OK) 764 res = Tcl_NewLongObj((long)value); 765 break; 766 case ENVGETLGREGIONMAX: 767 if (objc != 2) { 768 Tcl_WrongNumArgs(interp, 1, objv, NULL); 769 return (TCL_ERROR); 770 } 771 ret = dbenv->get_lg_regionmax(dbenv, &value); 772 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 773 "env get_lg_regionmax")) == TCL_OK) 774 res = Tcl_NewLongObj((long)value); 775 break; 776 case ENVGETLKDETECT: 777 result = env_GetLockDetect(interp, objc, objv, dbenv); 778 break; 779 case ENVGETLKMAXLOCKERS: 780 if (objc != 2) { 781 Tcl_WrongNumArgs(interp, 1, objv, NULL); 782 return (TCL_ERROR); 783 } 784 ret = dbenv->get_lk_max_lockers(dbenv, &value); 785 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 786 "env get_lk_max_lockers")) == TCL_OK) 787 res = Tcl_NewLongObj((long)value); 788 break; 789 case ENVGETLKMAXLOCKS: 790 if (objc != 2) { 791 Tcl_WrongNumArgs(interp, 1, objv, NULL); 792 return (TCL_ERROR); 793 } 794 ret = dbenv->get_lk_max_locks(dbenv, &value); 795 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 796 "env get_lk_max_locks")) == TCL_OK) 797 res = Tcl_NewLongObj((long)value); 798 break; 799 case ENVGETLKMAXOBJECTS: 800 if (objc != 2) { 801 Tcl_WrongNumArgs(interp, 1, objv, NULL); 802 return (TCL_ERROR); 803 } 804 ret = dbenv->get_lk_max_objects(dbenv, &value); 805 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 806 "env get_lk_max_objects")) == TCL_OK) 807 res = Tcl_NewLongObj((long)value); 808 break; 809 case ENVGETMPMAXOPENFD: 810 if (objc != 2) { 811 Tcl_WrongNumArgs(interp, 1, objv, NULL); 812 return (TCL_ERROR); 813 } 814 ret = dbenv->get_mp_max_openfd(dbenv, &intvalue); 815 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 816 "env get_mp_max_openfd")) == TCL_OK) 817 res = Tcl_NewIntObj(intvalue); 818 break; 819 case ENVGETMPMAXWRITE: 820 if (objc != 2) { 821 Tcl_WrongNumArgs(interp, 1, objv, NULL); 822 return (TCL_ERROR); 823 } 824 ret = dbenv->get_mp_max_write(dbenv, &intvalue, &timeout); 825 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 826 "env get_mp_max_write")) == TCL_OK) { 827 myobjv[0] = Tcl_NewIntObj(intvalue); 828 myobjv[1] = Tcl_NewIntObj((int)timeout); 829 res = Tcl_NewListObj(2, myobjv); 830 } 831 break; 832 case ENVGETMPMMAPSIZE: 833 if (objc != 2) { 834 Tcl_WrongNumArgs(interp, 1, objv, NULL); 835 return (TCL_ERROR); 836 } 837 ret = dbenv->get_mp_mmapsize(dbenv, &size); 838 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 839 "env get_mp_mmapsize")) == TCL_OK) 840 res = Tcl_NewLongObj((long)size); 841 break; 842 case ENVGETOPENFLAG: 843 result = env_GetOpenFlag(interp, objc, objv, dbenv); 844 break; 845 case ENVGETSHMKEY: 846 if (objc != 2) { 847 Tcl_WrongNumArgs(interp, 1, objv, NULL); 848 return (TCL_ERROR); 849 } 850 ret = dbenv->get_shm_key(dbenv, &shm_key); 851 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 852 "env shm_key")) == TCL_OK) 853 res = Tcl_NewLongObj(shm_key); 854 break; 855 case ENVGETTASSPINS: 856 if (objc != 2) { 857 Tcl_WrongNumArgs(interp, 1, objv, NULL); 858 return (TCL_ERROR); 859 } 860 ret = dbenv->mutex_get_tas_spins(dbenv, &value); 861 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 862 "env get_tas_spins")) == TCL_OK) 863 res = Tcl_NewLongObj((long)value); 864 break; 865 case ENVGETTIMEOUT: 866 result = env_GetTimeout(interp, objc, objv, dbenv); 867 break; 868 case ENVGETTMPDIR: 869 if (objc != 2) { 870 Tcl_WrongNumArgs(interp, 1, objv, NULL); 871 return (TCL_ERROR); 872 } 873 ret = dbenv->get_tmp_dir(dbenv, &strval); 874 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 875 "env get_tmp_dir")) == TCL_OK) 876 res = NewStringObj(strval, strlen(strval)); 877 break; 878 case ENVGETTXMAX: 879 if (objc != 2) { 880 Tcl_WrongNumArgs(interp, 1, objv, NULL); 881 return (TCL_ERROR); 882 } 883 ret = dbenv->get_tx_max(dbenv, &value); 884 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 885 "env get_tx_max")) == TCL_OK) 886 res = Tcl_NewLongObj((long)value); 887 break; 888 case ENVGETTXTIMESTAMP: 889 if (objc != 2) { 890 Tcl_WrongNumArgs(interp, 1, objv, NULL); 891 return (TCL_ERROR); 892 } 893 ret = dbenv->get_tx_timestamp(dbenv, &timeval); 894 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 895 "env get_tx_timestamp")) == TCL_OK) 896 res = Tcl_NewLongObj((long)timeval); 897 break; 898 case ENVGETVERBOSE: 899 result = env_GetVerbose(interp, objc, objv, dbenv); 900 break; 901 case ENVRESIZECACHE: 902 if ((result = Tcl_ListObjGetElements( 903 interp, objv[2], &listobjc, &listobjv)) != TCL_OK) 904 break; 905 if (objc != 3 || listobjc != 2) { 906 Tcl_WrongNumArgs(interp, 2, objv, 907 "?-resize_cache {gbytes bytes}?"); 908 result = TCL_ERROR; 909 break; 910 } 911 result = _GetUInt32(interp, listobjv[0], &gbytes); 912 if (result != TCL_OK) 913 break; 914 result = _GetUInt32(interp, listobjv[1], &bytes); 915 if (result != TCL_OK) 916 break; 917 ret = dbenv->set_cachesize(dbenv, gbytes, bytes, 0); 918 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 919 "resize_cache"); 920 break; 921 case ENVSETDATADIR: 922 /* 923 * One args for this. Error if different. 924 */ 925 if (objc != 3) { 926 Tcl_WrongNumArgs(interp, 2, objv, "pfx"); 927 return (TCL_ERROR); 928 } 929 strarg = Tcl_GetStringFromObj(objv[2], NULL); 930 ret = dbenv->set_data_dir(dbenv, strarg); 931 return (_ReturnSetup(interp, ret, DB_RETOK_STD(ret), 932 "env set data dir")); 933 case ENVTXN: 934 result = tcl_Txn(interp, objc, objv, dbenv, envip); 935 break; 936 case ENVTXNCKP: 937 result = tcl_TxnCheckpoint(interp, objc, objv, dbenv); 938 break; 939 } 940 /* 941 * Only set result if we have a res. Otherwise, lower 942 * functions have already done so. 943 */ 944 if (result == TCL_OK && res) 945 Tcl_SetObjResult(interp, res); 946 return (result); 947} 948 949/* 950 * PUBLIC: int tcl_EnvRemove __P((Tcl_Interp *, int, Tcl_Obj * CONST*, 951 * PUBLIC: DB_ENV *, DBTCL_INFO *)); 952 * 953 * tcl_EnvRemove -- 954 */ 955int 956tcl_EnvRemove(interp, objc, objv, dbenv, envip) 957 Tcl_Interp *interp; /* Interpreter */ 958 int objc; /* How many arguments? */ 959 Tcl_Obj *CONST objv[]; /* The argument objects */ 960 DB_ENV *dbenv; /* Env pointer */ 961 DBTCL_INFO *envip; /* Info pointer */ 962{ 963 static const char *envremopts[] = { 964#ifdef CONFIG_TEST 965 "-overwrite", 966 "-server", 967#endif 968 "-data_dir", 969 "-encryptaes", 970 "-encryptany", 971 "-force", 972 "-home", 973 "-log_dir", 974 "-tmp_dir", 975 "-use_environ", 976 "-use_environ_root", 977 NULL 978 }; 979 enum envremopts { 980#ifdef CONFIG_TEST 981 ENVREM_OVERWRITE, 982 ENVREM_SERVER, 983#endif 984 ENVREM_DATADIR, 985 ENVREM_ENCRYPT_AES, 986 ENVREM_ENCRYPT_ANY, 987 ENVREM_FORCE, 988 ENVREM_HOME, 989 ENVREM_LOGDIR, 990 ENVREM_TMPDIR, 991 ENVREM_USE_ENVIRON, 992 ENVREM_USE_ENVIRON_ROOT 993 }; 994 u_int32_t cflag, enc_flag, flag, forceflag, sflag; 995 int i, optindex, result, ret; 996 char *datadir, *home, *logdir, *passwd, *server, *tmpdir; 997 998 result = TCL_OK; 999 cflag = flag = forceflag = sflag = 0; 1000 home = NULL; 1001 passwd = NULL; 1002 datadir = logdir = tmpdir = NULL; 1003 server = NULL; 1004 enc_flag = 0; 1005 1006 if (objc < 2) { 1007 Tcl_WrongNumArgs(interp, 2, objv, "?args?"); 1008 return (TCL_ERROR); 1009 } 1010 1011 i = 2; 1012 while (i < objc) { 1013 if (Tcl_GetIndexFromObj(interp, objv[i], envremopts, "option", 1014 TCL_EXACT, &optindex) != TCL_OK) { 1015 result = IS_HELP(objv[i]); 1016 goto error; 1017 } 1018 i++; 1019 switch ((enum envremopts)optindex) { 1020#ifdef CONFIG_TEST 1021 case ENVREM_SERVER: 1022 /* Make sure we have an arg to check against! */ 1023 if (i >= objc) { 1024 Tcl_WrongNumArgs(interp, 2, objv, 1025 "?-server name?"); 1026 result = TCL_ERROR; 1027 break; 1028 } 1029 server = Tcl_GetStringFromObj(objv[i++], NULL); 1030 cflag = DB_RPCCLIENT; 1031 break; 1032#endif 1033 case ENVREM_ENCRYPT_AES: 1034 /* Make sure we have an arg to check against! */ 1035 if (i >= objc) { 1036 Tcl_WrongNumArgs(interp, 2, objv, 1037 "?-encryptaes passwd?"); 1038 result = TCL_ERROR; 1039 break; 1040 } 1041 passwd = Tcl_GetStringFromObj(objv[i++], NULL); 1042 enc_flag = DB_ENCRYPT_AES; 1043 break; 1044 case ENVREM_ENCRYPT_ANY: 1045 /* Make sure we have an arg to check against! */ 1046 if (i >= objc) { 1047 Tcl_WrongNumArgs(interp, 2, objv, 1048 "?-encryptany passwd?"); 1049 result = TCL_ERROR; 1050 break; 1051 } 1052 passwd = Tcl_GetStringFromObj(objv[i++], NULL); 1053 enc_flag = 0; 1054 break; 1055 case ENVREM_FORCE: 1056 forceflag |= DB_FORCE; 1057 break; 1058 case ENVREM_HOME: 1059 /* Make sure we have an arg to check against! */ 1060 if (i >= objc) { 1061 Tcl_WrongNumArgs(interp, 2, objv, 1062 "?-home dir?"); 1063 result = TCL_ERROR; 1064 break; 1065 } 1066 home = Tcl_GetStringFromObj(objv[i++], NULL); 1067 break; 1068#ifdef CONFIG_TEST 1069 case ENVREM_OVERWRITE: 1070 sflag |= DB_OVERWRITE; 1071 break; 1072#endif 1073 case ENVREM_USE_ENVIRON: 1074 flag |= DB_USE_ENVIRON; 1075 break; 1076 case ENVREM_USE_ENVIRON_ROOT: 1077 flag |= DB_USE_ENVIRON_ROOT; 1078 break; 1079 case ENVREM_DATADIR: 1080 if (i >= objc) { 1081 Tcl_WrongNumArgs(interp, 2, objv, 1082 "-data_dir dir"); 1083 result = TCL_ERROR; 1084 break; 1085 } 1086 datadir = Tcl_GetStringFromObj(objv[i++], NULL); 1087 break; 1088 case ENVREM_LOGDIR: 1089 if (i >= objc) { 1090 Tcl_WrongNumArgs(interp, 2, objv, 1091 "-log_dir dir"); 1092 result = TCL_ERROR; 1093 break; 1094 } 1095 logdir = Tcl_GetStringFromObj(objv[i++], NULL); 1096 break; 1097 case ENVREM_TMPDIR: 1098 if (i >= objc) { 1099 Tcl_WrongNumArgs(interp, 2, objv, 1100 "-tmp_dir dir"); 1101 result = TCL_ERROR; 1102 break; 1103 } 1104 tmpdir = Tcl_GetStringFromObj(objv[i++], NULL); 1105 break; 1106 } 1107 /* 1108 * If, at any time, parsing the args we get an error, 1109 * bail out and return. 1110 */ 1111 if (result != TCL_OK) 1112 goto error; 1113 } 1114 1115 /* 1116 * If dbenv is NULL, we don't have an open env and we need to open 1117 * one of the user. Don't bother with the info stuff. 1118 */ 1119 if (dbenv == NULL) { 1120 if ((ret = db_env_create(&dbenv, cflag)) != 0) { 1121 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 1122 "db_env_create"); 1123 goto error; 1124 } 1125 if (server != NULL) { 1126 _debug_check(); 1127 ret = dbenv->set_rpc_server( 1128 dbenv, NULL, server, 0, 0, 0); 1129 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 1130 "set_rpc_server"); 1131 if (result != TCL_OK) 1132 goto error; 1133 } 1134 if (datadir != NULL) { 1135 _debug_check(); 1136 ret = dbenv->set_data_dir(dbenv, datadir); 1137 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 1138 "set_data_dir"); 1139 if (result != TCL_OK) 1140 goto error; 1141 } 1142 if (logdir != NULL) { 1143 _debug_check(); 1144 ret = dbenv->set_lg_dir(dbenv, logdir); 1145 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 1146 "set_log_dir"); 1147 if (result != TCL_OK) 1148 goto error; 1149 } 1150 if (tmpdir != NULL) { 1151 _debug_check(); 1152 ret = dbenv->set_tmp_dir(dbenv, tmpdir); 1153 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 1154 "set_tmp_dir"); 1155 if (result != TCL_OK) 1156 goto error; 1157 } 1158 if (passwd != NULL) { 1159 ret = dbenv->set_encrypt(dbenv, passwd, enc_flag); 1160 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 1161 "set_encrypt"); 1162 } 1163 if (sflag != 0 && 1164 (ret = dbenv->set_flags(dbenv, sflag, 1)) != 0) { 1165 _debug_check(); 1166 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 1167 "set_flags"); 1168 if (result != TCL_OK) 1169 goto error; 1170 } 1171 dbenv->set_errpfx(dbenv, "EnvRemove"); 1172 dbenv->set_errcall(dbenv, _ErrorFunc); 1173 } else { 1174 /* 1175 * We have to clean up any info associated with this env, 1176 * regardless of the result of the remove so do it first. 1177 * NOTE: envip is freed when we come back from this function. 1178 */ 1179 _EnvInfoDelete(interp, envip); 1180 envip = NULL; 1181 } 1182 1183 flag |= forceflag; 1184 /* 1185 * When we get here we have parsed all the args. Now remove 1186 * the environment. 1187 */ 1188 _debug_check(); 1189 ret = dbenv->remove(dbenv, home, flag); 1190 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "env remove"); 1191error: 1192 return (result); 1193} 1194 1195static void 1196_EnvInfoDelete(interp, envip) 1197 Tcl_Interp *interp; /* Tcl Interpreter */ 1198 DBTCL_INFO *envip; /* Info for env */ 1199{ 1200 DBTCL_INFO *nextp, *p; 1201 1202 /* 1203 * Before we can delete the environment info, we must close 1204 * any open subsystems in this env. We will: 1205 * 1. Abort any transactions (which aborts any nested txns). 1206 * 2. Close any mpools (which will put any pages itself). 1207 * 3. Put any locks and close log cursors. 1208 * 4. Close the error file. 1209 */ 1210 for (p = LIST_FIRST(&__db_infohead); p != NULL; p = nextp) { 1211 /* 1212 * Check if this info structure "belongs" to this 1213 * env. If so, remove its commands and info structure. 1214 * We do not close/abort/whatever here, because we 1215 * don't want to replicate DB behavior. 1216 * 1217 * NOTE: Only those types that can nest need to be 1218 * itemized in the switch below. That is txns and mps. 1219 * Other types like log cursors and locks will just 1220 * get cleaned up here. 1221 */ 1222 if (p->i_parent == envip) { 1223 switch (p->i_type) { 1224 case I_TXN: 1225 _TxnInfoDelete(interp, p); 1226 break; 1227 case I_MP: 1228 _MpInfoDelete(interp, p); 1229 break; 1230 case I_DB: 1231 case I_DBC: 1232 case I_ENV: 1233 case I_LOCK: 1234 case I_LOGC: 1235 case I_NDBM: 1236 case I_PG: 1237 case I_SEQ: 1238 Tcl_SetResult(interp, 1239 "_EnvInfoDelete: bad info type", 1240 TCL_STATIC); 1241 break; 1242 } 1243 nextp = LIST_NEXT(p, entries); 1244 (void)Tcl_DeleteCommand(interp, p->i_name); 1245 _DeleteInfo(p); 1246 } else 1247 nextp = LIST_NEXT(p, entries); 1248 } 1249 (void)Tcl_DeleteCommand(interp, envip->i_name); 1250 _DeleteInfo(envip); 1251} 1252 1253#ifdef CONFIG_TEST 1254/* 1255 * PUBLIC: int tcl_EnvIdReset __P((Tcl_Interp *, int, Tcl_Obj * CONST*, 1256 * PUBLIC: DB_ENV *)); 1257 * 1258 * tcl_EnvIdReset -- 1259 * Implements the ENV->fileid_reset command. 1260 */ 1261int 1262tcl_EnvIdReset(interp, objc, objv, dbenv) 1263 Tcl_Interp *interp; /* Interpreter */ 1264 int objc; /* arg count */ 1265 Tcl_Obj * CONST* objv; /* args */ 1266 DB_ENV *dbenv; /* Database pointer */ 1267{ 1268 static const char *idwhich[] = { 1269 "-encrypt", 1270 NULL 1271 }; 1272 enum idwhich { 1273 IDENCRYPT 1274 }; 1275 int enc, i, result, ret; 1276 u_int32_t flags; 1277 char *file; 1278 1279 result = TCL_OK; 1280 flags = 0; 1281 i = 2; 1282 Tcl_SetResult(interp, "0", TCL_STATIC); 1283 if (objc < 3) { 1284 Tcl_WrongNumArgs(interp, 2, objv, "?-encrypt? filename"); 1285 return (TCL_ERROR); 1286 } else if (objc > 3) { 1287 /* 1288 * If there is an arg, make sure it is the right one. 1289 */ 1290 if (Tcl_GetIndexFromObj(interp, objv[2], idwhich, "option", 1291 TCL_EXACT, &enc) != TCL_OK) 1292 return (IS_HELP(objv[2])); 1293 switch ((enum idwhich)enc) { 1294 case IDENCRYPT: 1295 flags |= DB_ENCRYPT; 1296 break; 1297 } 1298 i = 3; 1299 } 1300 file = Tcl_GetStringFromObj(objv[i], NULL); 1301 ret = dbenv->fileid_reset(dbenv, file, flags); 1302 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "fileid reset"); 1303 return (result); 1304} 1305 1306/* 1307 * PUBLIC: int tcl_EnvLsnReset __P((Tcl_Interp *, int, Tcl_Obj * CONST*, 1308 * PUBLIC: DB_ENV *)); 1309 * 1310 * tcl_EnvLsnReset -- 1311 * Implements the ENV->lsn_reset command. 1312 */ 1313int 1314tcl_EnvLsnReset(interp, objc, objv, dbenv) 1315 Tcl_Interp *interp; /* Interpreter */ 1316 int objc; /* arg count */ 1317 Tcl_Obj * CONST* objv; /* args */ 1318 DB_ENV *dbenv; /* Database pointer */ 1319{ 1320 static const char *lsnwhich[] = { 1321 "-encrypt", 1322 NULL 1323 }; 1324 enum lsnwhich { 1325 IDENCRYPT 1326 }; 1327 int enc, i, result, ret; 1328 u_int32_t flags; 1329 char *file; 1330 1331 result = TCL_OK; 1332 flags = 0; 1333 i = 2; 1334 Tcl_SetResult(interp, "0", TCL_STATIC); 1335 if (objc < 3) { 1336 Tcl_WrongNumArgs(interp, 2, objv, "?-encrypt? filename"); 1337 return (TCL_ERROR); 1338 } else if (objc > 3) { 1339 /* 1340 * If there is an arg, make sure it is the right one. 1341 */ 1342 if (Tcl_GetIndexFromObj(interp, objv[2], lsnwhich, "option", 1343 TCL_EXACT, &enc) != TCL_OK) 1344 return (IS_HELP(objv[2])); 1345 1346 switch ((enum lsnwhich)enc) { 1347 case IDENCRYPT: 1348 flags |= DB_ENCRYPT; 1349 break; 1350 } 1351 i = 3; 1352 } 1353 file = Tcl_GetStringFromObj(objv[i], NULL); 1354 ret = dbenv->lsn_reset(dbenv, file, flags); 1355 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "lsn reset"); 1356 return (result); 1357} 1358 1359/* 1360 * PUBLIC: int tcl_EnvVerbose __P((Tcl_Interp *, DB_ENV *, Tcl_Obj *, 1361 * PUBLIC: Tcl_Obj *)); 1362 * 1363 * tcl_EnvVerbose -- 1364 */ 1365int 1366tcl_EnvVerbose(interp, dbenv, which, onoff) 1367 Tcl_Interp *interp; /* Interpreter */ 1368 DB_ENV *dbenv; /* Env pointer */ 1369 Tcl_Obj *which; /* Which subsystem */ 1370 Tcl_Obj *onoff; /* On or off */ 1371{ 1372 static const char *verbwhich[] = { 1373 "deadlock", 1374 "fileops", 1375 "fileops_all", 1376 "recovery", 1377 "register", 1378 "rep", 1379 "rep_elect", 1380 "rep_lease", 1381 "rep_misc", 1382 "rep_msgs", 1383 "rep_sync", 1384 "repmgr_connfail", 1385 "repmgr_misc", 1386 "wait", 1387 NULL 1388 }; 1389 enum verbwhich { 1390 ENVVERB_DEADLOCK, 1391 ENVVERB_FILEOPS, 1392 ENVVERB_FILEOPS_ALL, 1393 ENVVERB_RECOVERY, 1394 ENVVERB_REGISTER, 1395 ENVVERB_REPLICATION, 1396 ENVVERB_REP_ELECT, 1397 ENVVERB_REP_LEASE, 1398 ENVVERB_REP_MISC, 1399 ENVVERB_REP_MSGS, 1400 ENVVERB_REP_SYNC, 1401 ENVVERB_REPMGR_CONNFAIL, 1402 ENVVERB_REPMGR_MISC, 1403 ENVVERB_WAITSFOR 1404 }; 1405 static const char *verbonoff[] = { 1406 "off", 1407 "on", 1408 NULL 1409 }; 1410 enum verbonoff { 1411 ENVVERB_OFF, 1412 ENVVERB_ON 1413 }; 1414 int on, optindex, ret; 1415 u_int32_t wh; 1416 1417 if (Tcl_GetIndexFromObj(interp, which, verbwhich, "option", 1418 TCL_EXACT, &optindex) != TCL_OK) 1419 return (IS_HELP(which)); 1420 1421 switch ((enum verbwhich)optindex) { 1422 case ENVVERB_DEADLOCK: 1423 wh = DB_VERB_DEADLOCK; 1424 break; 1425 case ENVVERB_FILEOPS: 1426 wh = DB_VERB_FILEOPS; 1427 break; 1428 case ENVVERB_FILEOPS_ALL: 1429 wh = DB_VERB_FILEOPS_ALL; 1430 break; 1431 case ENVVERB_RECOVERY: 1432 wh = DB_VERB_RECOVERY; 1433 break; 1434 case ENVVERB_REGISTER: 1435 wh = DB_VERB_REGISTER; 1436 break; 1437 case ENVVERB_REPLICATION: 1438 wh = DB_VERB_REPLICATION; 1439 break; 1440 case ENVVERB_REP_ELECT: 1441 wh = DB_VERB_REP_ELECT; 1442 break; 1443 case ENVVERB_REP_LEASE: 1444 wh = DB_VERB_REP_LEASE; 1445 break; 1446 case ENVVERB_REP_MISC: 1447 wh = DB_VERB_REP_MISC; 1448 break; 1449 case ENVVERB_REP_MSGS: 1450 wh = DB_VERB_REP_MSGS; 1451 break; 1452 case ENVVERB_REP_SYNC: 1453 wh = DB_VERB_REP_SYNC; 1454 break; 1455 case ENVVERB_REPMGR_CONNFAIL: 1456 wh = DB_VERB_REPMGR_CONNFAIL; 1457 break; 1458 case ENVVERB_REPMGR_MISC: 1459 wh = DB_VERB_REPMGR_MISC; 1460 break; 1461 case ENVVERB_WAITSFOR: 1462 wh = DB_VERB_WAITSFOR; 1463 break; 1464 default: 1465 return (TCL_ERROR); 1466 } 1467 if (Tcl_GetIndexFromObj(interp, onoff, verbonoff, "option", 1468 TCL_EXACT, &optindex) != TCL_OK) 1469 return (IS_HELP(onoff)); 1470 switch ((enum verbonoff)optindex) { 1471 case ENVVERB_OFF: 1472 on = 0; 1473 break; 1474 case ENVVERB_ON: 1475 on = 1; 1476 break; 1477 default: 1478 return (TCL_ERROR); 1479 } 1480 ret = dbenv->set_verbose(dbenv, wh, on); 1481 return (_ReturnSetup(interp, ret, DB_RETOK_STD(ret), 1482 "env set verbose")); 1483} 1484#endif 1485 1486#ifdef CONFIG_TEST 1487/* 1488 * PUBLIC: int tcl_EnvAttr __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *)); 1489 * 1490 * tcl_EnvAttr -- 1491 * Return a list of the env's attributes 1492 */ 1493int 1494tcl_EnvAttr(interp, objc, objv, dbenv) 1495 Tcl_Interp *interp; /* Interpreter */ 1496 int objc; /* How many arguments? */ 1497 Tcl_Obj *CONST objv[]; /* The argument objects */ 1498 DB_ENV *dbenv; /* Env pointer */ 1499{ 1500 ENV *env; 1501 Tcl_Obj *myobj, *retlist; 1502 int result; 1503 1504 env = dbenv->env; 1505 result = TCL_OK; 1506 1507 if (objc > 2) { 1508 Tcl_WrongNumArgs(interp, 2, objv, NULL); 1509 return (TCL_ERROR); 1510 } 1511 retlist = Tcl_NewListObj(0, NULL); 1512 /* 1513 * XXX 1514 * We peek at the ENV to determine what subsystems we have available 1515 * in this environment. 1516 */ 1517 myobj = NewStringObj("-home", strlen("-home")); 1518 if ((result = Tcl_ListObjAppendElement(interp, 1519 retlist, myobj)) != TCL_OK) 1520 goto err; 1521 myobj = NewStringObj(env->db_home, strlen(env->db_home)); 1522 if ((result = Tcl_ListObjAppendElement(interp, 1523 retlist, myobj)) != TCL_OK) 1524 goto err; 1525 if (CDB_LOCKING(env)) { 1526 myobj = NewStringObj("-cdb", strlen("-cdb")); 1527 if ((result = Tcl_ListObjAppendElement(interp, 1528 retlist, myobj)) != TCL_OK) 1529 goto err; 1530 } 1531 if (CRYPTO_ON(env)) { 1532 myobj = NewStringObj("-crypto", strlen("-crypto")); 1533 if ((result = Tcl_ListObjAppendElement(interp, 1534 retlist, myobj)) != TCL_OK) 1535 goto err; 1536 } 1537 if (LOCKING_ON(env)) { 1538 myobj = NewStringObj("-lock", strlen("-lock")); 1539 if ((result = Tcl_ListObjAppendElement(interp, 1540 retlist, myobj)) != TCL_OK) 1541 goto err; 1542 } 1543 if (LOGGING_ON(env)) { 1544 myobj = NewStringObj("-log", strlen("-log")); 1545 if ((result = Tcl_ListObjAppendElement(interp, 1546 retlist, myobj)) != TCL_OK) 1547 goto err; 1548 } 1549 if (MPOOL_ON(env)) { 1550 myobj = NewStringObj("-mpool", strlen("-mpool")); 1551 if ((result = Tcl_ListObjAppendElement(interp, 1552 retlist, myobj)) != TCL_OK) 1553 goto err; 1554 } 1555 if (RPC_ON(dbenv)) { 1556 myobj = NewStringObj("-rpc", strlen("-rpc")); 1557 if ((result = Tcl_ListObjAppendElement(interp, 1558 retlist, myobj)) != TCL_OK) 1559 goto err; 1560 } 1561 if (REP_ON(env)) { 1562 myobj = NewStringObj("-rep", strlen("-rep")); 1563 if ((result = Tcl_ListObjAppendElement(interp, 1564 retlist, myobj)) != TCL_OK) 1565 goto err; 1566 } 1567 if (TXN_ON(env)) { 1568 myobj = NewStringObj("-txn", strlen("-txn")); 1569 if ((result = Tcl_ListObjAppendElement(interp, 1570 retlist, myobj)) != TCL_OK) 1571 goto err; 1572 } 1573 Tcl_SetObjResult(interp, retlist); 1574err: 1575 return (result); 1576} 1577 1578/* 1579 * tcl_EventNotify -- 1580 * Call DB_ENV->set_event_notify(). 1581 * 1582 * PUBLIC: int tcl_EventNotify __P((Tcl_Interp *, DB_ENV *, Tcl_Obj *, 1583 * PUBLIC: DBTCL_INFO *)); 1584 * 1585 * Note that this normally can/should be achieved as an argument to 1586 * berkdb env, but we need to test changing the event function on 1587 * the fly. 1588 */ 1589int 1590tcl_EventNotify(interp, dbenv, eobj, ip) 1591 Tcl_Interp *interp; /* Interpreter */ 1592 DB_ENV *dbenv; 1593 Tcl_Obj *eobj; /* The event proc */ 1594 DBTCL_INFO *ip; 1595{ 1596 int ret; 1597 1598 /* 1599 * We don't need to crack the event procedure out now. 1600 */ 1601 /* 1602 * If we're replacing an existing event proc, decrement it now. 1603 */ 1604 if (ip->i_event != NULL) { 1605 Tcl_DecrRefCount(ip->i_event); 1606 } 1607 ip->i_event = eobj; 1608 Tcl_IncrRefCount(ip->i_event); 1609 _debug_check(); 1610 ret = dbenv->set_event_notify(dbenv, _EventFunc); 1611 return (_ReturnSetup(interp, ret, DB_RETOK_STD(ret), "env event")); 1612} 1613 1614/* 1615 * PUBLIC: int tcl_EnvSetFlags __P((Tcl_Interp *, DB_ENV *, Tcl_Obj *, 1616 * PUBLIC: Tcl_Obj *)); 1617 * 1618 * tcl_EnvSetFlags -- 1619 * Set flags in an env. 1620 */ 1621int 1622tcl_EnvSetFlags(interp, dbenv, which, onoff) 1623 Tcl_Interp *interp; /* Interpreter */ 1624 DB_ENV *dbenv; /* Env pointer */ 1625 Tcl_Obj *which; /* Which subsystem */ 1626 Tcl_Obj *onoff; /* On or off */ 1627{ 1628 static const char *sfwhich[] = { 1629 "-auto_commit", 1630 "-direct_db", 1631 "-multiversion", 1632 "-nolock", 1633 "-nommap", 1634 "-nopanic", 1635 "-nosync", 1636 "-overwrite", 1637 "-panic", 1638 "-wrnosync", 1639 NULL 1640 }; 1641 enum sfwhich { 1642 ENVSF_AUTOCOMMIT, 1643 ENVSF_DIRECTDB, 1644 ENVSF_MULTIVERSION, 1645 ENVSF_NOLOCK, 1646 ENVSF_NOMMAP, 1647 ENVSF_NOPANIC, 1648 ENVSF_NOSYNC, 1649 ENVSF_OVERWRITE, 1650 ENVSF_PANIC, 1651 ENVSF_WRNOSYNC 1652 }; 1653 static const char *sfonoff[] = { 1654 "off", 1655 "on", 1656 NULL 1657 }; 1658 enum sfonoff { 1659 ENVSF_OFF, 1660 ENVSF_ON 1661 }; 1662 int on, optindex, ret; 1663 u_int32_t wh; 1664 1665 if (Tcl_GetIndexFromObj(interp, which, sfwhich, "option", 1666 TCL_EXACT, &optindex) != TCL_OK) 1667 return (IS_HELP(which)); 1668 1669 switch ((enum sfwhich)optindex) { 1670 case ENVSF_AUTOCOMMIT: 1671 wh = DB_AUTO_COMMIT; 1672 break; 1673 case ENVSF_DIRECTDB: 1674 wh = DB_DIRECT_DB; 1675 break; 1676 case ENVSF_MULTIVERSION: 1677 wh = DB_MULTIVERSION; 1678 break; 1679 case ENVSF_NOLOCK: 1680 wh = DB_NOLOCKING; 1681 break; 1682 case ENVSF_NOMMAP: 1683 wh = DB_NOMMAP; 1684 break; 1685 case ENVSF_NOSYNC: 1686 wh = DB_TXN_NOSYNC; 1687 break; 1688 case ENVSF_NOPANIC: 1689 wh = DB_NOPANIC; 1690 break; 1691 case ENVSF_PANIC: 1692 wh = DB_PANIC_ENVIRONMENT; 1693 break; 1694 case ENVSF_OVERWRITE: 1695 wh = DB_OVERWRITE; 1696 break; 1697 case ENVSF_WRNOSYNC: 1698 wh = DB_TXN_WRITE_NOSYNC; 1699 break; 1700 default: 1701 return (TCL_ERROR); 1702 } 1703 if (Tcl_GetIndexFromObj(interp, onoff, sfonoff, "option", 1704 TCL_EXACT, &optindex) != TCL_OK) 1705 return (IS_HELP(onoff)); 1706 switch ((enum sfonoff)optindex) { 1707 case ENVSF_OFF: 1708 on = 0; 1709 break; 1710 case ENVSF_ON: 1711 on = 1; 1712 break; 1713 default: 1714 return (TCL_ERROR); 1715 } 1716 ret = dbenv->set_flags(dbenv, wh, on); 1717 return (_ReturnSetup(interp, ret, DB_RETOK_STD(ret), 1718 "env set flags")); 1719} 1720 1721/* 1722 * tcl_EnvTest -- 1723 * The "$env test ..." command is a sort of catch-all for any sort of 1724 * desired test hook manipulation. The "abort", "check" and "copy" subcommands 1725 * all set one or another certain location in the DB_ENV handle to a specific 1726 * value. (In the case of "check", the value is an integer passed in with the 1727 * command itself. For the other two, the "value" is a predefined enum 1728 * constant, specified by name.) 1729 * The "$env test force ..." subcommand invokes other, more arbitrary 1730 * manipulations. 1731 * Although these functions may not all seem closely related, putting them 1732 * all under the name "test" has the aesthetic appeal of keeping the rest of the 1733 * API clean. 1734 * 1735 * PUBLIC: int tcl_EnvTest __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *)); 1736 */ 1737int 1738tcl_EnvTest(interp, objc, objv, dbenv) 1739 Tcl_Interp *interp; /* Interpreter */ 1740 int objc; /* How many arguments? */ 1741 Tcl_Obj *CONST objv[]; /* The argument objects */ 1742 DB_ENV *dbenv; /* Env pointer */ 1743{ 1744 static const char *envtestcmd[] = { 1745 "abort", 1746 "check", 1747 "copy", 1748 "force", 1749 NULL 1750 }; 1751 enum envtestcmd { 1752 ENVTEST_ABORT, 1753 ENVTEST_CHECK, 1754 ENVTEST_COPY, 1755 ENVTEST_FORCE 1756 }; 1757 static const char *envtestat[] = { 1758 "electinit", 1759 "electvote1", 1760 "none", 1761 "predestroy", 1762 "preopen", 1763 "postdestroy", 1764 "postlog", 1765 "postlogmeta", 1766 "postopen", 1767 "postsync", 1768 "subdb_lock", 1769 NULL 1770 }; 1771 enum envtestat { 1772 ENVTEST_ELECTINIT, 1773 ENVTEST_ELECTVOTE1, 1774 ENVTEST_NONE, 1775 ENVTEST_PREDESTROY, 1776 ENVTEST_PREOPEN, 1777 ENVTEST_POSTDESTROY, 1778 ENVTEST_POSTLOG, 1779 ENVTEST_POSTLOGMETA, 1780 ENVTEST_POSTOPEN, 1781 ENVTEST_POSTSYNC, 1782 ENVTEST_SUBDB_LOCKS 1783 }; 1784 static const char *envtestforce[] = { 1785 "noarchive_timeout", 1786 NULL 1787 }; 1788 enum envtestforce { 1789 ENVTEST_NOARCHIVE_TIMEOUT 1790 }; 1791 ENV *env; 1792 int *loc, optindex, result, testval; 1793 1794 env = dbenv->env; 1795 result = TCL_OK; 1796 loc = NULL; 1797 1798 if (objc != 4) { 1799 Tcl_WrongNumArgs(interp, 1800 2, objv, "abort|check|copy|force <args>"); 1801 return (TCL_ERROR); 1802 } 1803 1804 /* 1805 * This must be the "check", "copy" or "abort" portion of the command. 1806 */ 1807 if (Tcl_GetIndexFromObj(interp, objv[2], envtestcmd, "command", 1808 TCL_EXACT, &optindex) != TCL_OK) { 1809 result = IS_HELP(objv[2]); 1810 return (result); 1811 } 1812 switch ((enum envtestcmd)optindex) { 1813 case ENVTEST_ABORT: 1814 loc = &env->test_abort; 1815 break; 1816 case ENVTEST_CHECK: 1817 loc = &env->test_check; 1818 if (Tcl_GetIntFromObj(interp, objv[3], &testval) != TCL_OK) { 1819 result = IS_HELP(objv[3]); 1820 return (result); 1821 } 1822 goto done; 1823 case ENVTEST_COPY: 1824 loc = &env->test_copy; 1825 break; 1826 case ENVTEST_FORCE: 1827 if (Tcl_GetIndexFromObj(interp, objv[3], envtestforce, "arg", 1828 TCL_EXACT, &optindex) != TCL_OK) { 1829 result = IS_HELP(objv[3]); 1830 return (result); 1831 } 1832 /* 1833 * In the future we might add more, and then we'd use a switch 1834 * statement. 1835 */ 1836 DB_ASSERT(env, 1837 (enum envtestforce)optindex == ENVTEST_NOARCHIVE_TIMEOUT); 1838 return (tcl_RepNoarchiveTimeout(interp, dbenv)); 1839 default: 1840 Tcl_SetResult(interp, "Illegal store location", TCL_STATIC); 1841 return (TCL_ERROR); 1842 } 1843 1844 /* 1845 * This must be the location portion of the command. 1846 */ 1847 if (Tcl_GetIndexFromObj(interp, objv[3], envtestat, "location", 1848 TCL_EXACT, &optindex) != TCL_OK) { 1849 result = IS_HELP(objv[3]); 1850 return (result); 1851 } 1852 switch ((enum envtestat)optindex) { 1853 case ENVTEST_ELECTINIT: 1854 DB_ASSERT(env, loc == &env->test_abort); 1855 testval = DB_TEST_ELECTINIT; 1856 break; 1857 case ENVTEST_ELECTVOTE1: 1858 DB_ASSERT(env, loc == &env->test_abort); 1859 testval = DB_TEST_ELECTVOTE1; 1860 break; 1861 case ENVTEST_NONE: 1862 testval = 0; 1863 break; 1864 case ENVTEST_PREOPEN: 1865 testval = DB_TEST_PREOPEN; 1866 break; 1867 case ENVTEST_PREDESTROY: 1868 testval = DB_TEST_PREDESTROY; 1869 break; 1870 case ENVTEST_POSTLOG: 1871 testval = DB_TEST_POSTLOG; 1872 break; 1873 case ENVTEST_POSTLOGMETA: 1874 testval = DB_TEST_POSTLOGMETA; 1875 break; 1876 case ENVTEST_POSTOPEN: 1877 testval = DB_TEST_POSTOPEN; 1878 break; 1879 case ENVTEST_POSTDESTROY: 1880 testval = DB_TEST_POSTDESTROY; 1881 break; 1882 case ENVTEST_POSTSYNC: 1883 testval = DB_TEST_POSTSYNC; 1884 break; 1885 case ENVTEST_SUBDB_LOCKS: 1886 DB_ASSERT(env, loc == &env->test_abort); 1887 testval = DB_TEST_SUBDB_LOCKS; 1888 break; 1889 default: 1890 Tcl_SetResult(interp, "Illegal test location", TCL_STATIC); 1891 return (TCL_ERROR); 1892 } 1893done: 1894 *loc = testval; 1895 Tcl_SetResult(interp, "0", TCL_STATIC); 1896 return (result); 1897} 1898#endif 1899 1900/* 1901 * env_DbRemove -- 1902 * Implements the ENV->dbremove command. 1903 */ 1904static int 1905env_DbRemove(interp, objc, objv, dbenv) 1906 Tcl_Interp *interp; /* Interpreter */ 1907 int objc; /* How many arguments? */ 1908 Tcl_Obj *CONST objv[]; /* The argument objects */ 1909 DB_ENV *dbenv; 1910{ 1911 static const char *envdbrem[] = { 1912 "-auto_commit", 1913 "-txn", 1914 "--", 1915 NULL 1916 }; 1917 enum envdbrem { 1918 TCL_EDBREM_COMMIT, 1919 TCL_EDBREM_TXN, 1920 TCL_EDBREM_ENDARG 1921 }; 1922 DB_TXN *txn; 1923 u_int32_t flag; 1924 int endarg, i, optindex, result, ret, subdblen; 1925 u_char *subdbtmp; 1926 char *arg, *db, *subdb, msg[MSG_SIZE]; 1927 1928 txn = NULL; 1929 result = TCL_OK; 1930 subdbtmp = NULL; 1931 db = subdb = NULL; 1932 endarg = 0; 1933 flag = 0; 1934 1935 if (objc < 2) { 1936 Tcl_WrongNumArgs(interp, 2, objv, "?args? filename ?database?"); 1937 return (TCL_ERROR); 1938 } 1939 1940 /* 1941 * We must first parse for the environment flag, since that 1942 * is needed for db_create. Then create the db handle. 1943 */ 1944 i = 2; 1945 while (i < objc) { 1946 if (Tcl_GetIndexFromObj(interp, objv[i], envdbrem, 1947 "option", TCL_EXACT, &optindex) != TCL_OK) { 1948 arg = Tcl_GetStringFromObj(objv[i], NULL); 1949 if (arg[0] == '-') { 1950 result = IS_HELP(objv[i]); 1951 goto error; 1952 } else 1953 Tcl_ResetResult(interp); 1954 break; 1955 } 1956 i++; 1957 switch ((enum envdbrem)optindex) { 1958 case TCL_EDBREM_COMMIT: 1959 flag |= DB_AUTO_COMMIT; 1960 break; 1961 case TCL_EDBREM_TXN: 1962 if (i >= objc) { 1963 Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?"); 1964 result = TCL_ERROR; 1965 break; 1966 } 1967 arg = Tcl_GetStringFromObj(objv[i++], NULL); 1968 txn = NAME_TO_TXN(arg); 1969 if (txn == NULL) { 1970 snprintf(msg, MSG_SIZE, 1971 "env dbremove: Invalid txn %s\n", arg); 1972 Tcl_SetResult(interp, msg, TCL_VOLATILE); 1973 return (TCL_ERROR); 1974 } 1975 break; 1976 case TCL_EDBREM_ENDARG: 1977 endarg = 1; 1978 break; 1979 } 1980 /* 1981 * If, at any time, parsing the args we get an error, 1982 * bail out and return. 1983 */ 1984 if (result != TCL_OK) 1985 goto error; 1986 if (endarg) 1987 break; 1988 } 1989 if (result != TCL_OK) 1990 goto error; 1991 /* 1992 * Any args we have left, (better be 1 or 2 left) are 1993 * file names. If there is 1, a db name, if 2 a db and subdb name. 1994 */ 1995 if ((i != (objc - 1)) || (i != (objc - 2))) { 1996 /* 1997 * Dbs must be NULL terminated file names, but subdbs can 1998 * be anything. Use Strings for the db name and byte 1999 * arrays for the subdb. 2000 */ 2001 db = Tcl_GetStringFromObj(objv[i++], NULL); 2002 if (strcmp(db, "") == 0) 2003 db = NULL; 2004 if (i != objc) { 2005 subdbtmp = 2006 Tcl_GetByteArrayFromObj(objv[i++], &subdblen); 2007 if ((ret = __os_malloc( 2008 dbenv->env, (size_t)subdblen + 1, &subdb)) != 0) { 2009 Tcl_SetResult(interp, 2010 db_strerror(ret), TCL_STATIC); 2011 return (0); 2012 } 2013 memcpy(subdb, subdbtmp, (size_t)subdblen); 2014 subdb[subdblen] = '\0'; 2015 } 2016 } else { 2017 Tcl_WrongNumArgs(interp, 2, objv, "?args? filename ?database?"); 2018 result = TCL_ERROR; 2019 goto error; 2020 } 2021 ret = dbenv->dbremove(dbenv, txn, db, subdb, flag); 2022 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 2023 "env dbremove"); 2024error: 2025 if (subdb) 2026 __os_free(dbenv->env, subdb); 2027 return (result); 2028} 2029 2030/* 2031 * env_DbRename -- 2032 * Implements the ENV->dbrename command. 2033 */ 2034static int 2035env_DbRename(interp, objc, objv, dbenv) 2036 Tcl_Interp *interp; /* Interpreter */ 2037 int objc; /* How many arguments? */ 2038 Tcl_Obj *CONST objv[]; /* The argument objects */ 2039 DB_ENV *dbenv; 2040{ 2041 static const char *envdbmv[] = { 2042 "-auto_commit", 2043 "-txn", 2044 "--", 2045 NULL 2046 }; 2047 enum envdbmv { 2048 TCL_EDBMV_COMMIT, 2049 TCL_EDBMV_TXN, 2050 TCL_EDBMV_ENDARG 2051 }; 2052 DB_TXN *txn; 2053 u_int32_t flag; 2054 int endarg, i, newlen, optindex, result, ret, subdblen; 2055 u_char *subdbtmp; 2056 char *arg, *db, *newname, *subdb, msg[MSG_SIZE]; 2057 2058 txn = NULL; 2059 result = TCL_OK; 2060 subdbtmp = NULL; 2061 db = newname = subdb = NULL; 2062 endarg = 0; 2063 flag = 0; 2064 2065 if (objc < 2) { 2066 Tcl_WrongNumArgs(interp, 3, objv, 2067 "?args? filename ?database? ?newname?"); 2068 return (TCL_ERROR); 2069 } 2070 2071 /* 2072 * We must first parse for the environment flag, since that 2073 * is needed for db_create. Then create the db handle. 2074 */ 2075 i = 2; 2076 while (i < objc) { 2077 if (Tcl_GetIndexFromObj(interp, objv[i], envdbmv, 2078 "option", TCL_EXACT, &optindex) != TCL_OK) { 2079 arg = Tcl_GetStringFromObj(objv[i], NULL); 2080 if (arg[0] == '-') { 2081 result = IS_HELP(objv[i]); 2082 goto error; 2083 } else 2084 Tcl_ResetResult(interp); 2085 break; 2086 } 2087 i++; 2088 switch ((enum envdbmv)optindex) { 2089 case TCL_EDBMV_COMMIT: 2090 flag |= DB_AUTO_COMMIT; 2091 break; 2092 case TCL_EDBMV_TXN: 2093 if (i >= objc) { 2094 Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?"); 2095 result = TCL_ERROR; 2096 break; 2097 } 2098 arg = Tcl_GetStringFromObj(objv[i++], NULL); 2099 txn = NAME_TO_TXN(arg); 2100 if (txn == NULL) { 2101 snprintf(msg, MSG_SIZE, 2102 "env dbrename: Invalid txn %s\n", arg); 2103 Tcl_SetResult(interp, msg, TCL_VOLATILE); 2104 return (TCL_ERROR); 2105 } 2106 break; 2107 case TCL_EDBMV_ENDARG: 2108 endarg = 1; 2109 break; 2110 } 2111 /* 2112 * If, at any time, parsing the args we get an error, 2113 * bail out and return. 2114 */ 2115 if (result != TCL_OK) 2116 goto error; 2117 if (endarg) 2118 break; 2119 } 2120 if (result != TCL_OK) 2121 goto error; 2122 /* 2123 * Any args we have left, (better be 2 or 3 left) are 2124 * file names. If there is 2, a db name, if 3 a db and subdb name. 2125 */ 2126 if ((i != (objc - 2)) || (i != (objc - 3))) { 2127 /* 2128 * Dbs must be NULL terminated file names, but subdbs can 2129 * be anything. Use Strings for the db name and byte 2130 * arrays for the subdb. 2131 */ 2132 db = Tcl_GetStringFromObj(objv[i++], NULL); 2133 if (strcmp(db, "") == 0) 2134 db = NULL; 2135 if (i == objc - 2) { 2136 subdbtmp = 2137 Tcl_GetByteArrayFromObj(objv[i++], &subdblen); 2138 if ((ret = __os_malloc( 2139 dbenv->env, (size_t)subdblen + 1, &subdb)) != 0) { 2140 Tcl_SetResult(interp, 2141 db_strerror(ret), TCL_STATIC); 2142 return (0); 2143 } 2144 memcpy(subdb, subdbtmp, (size_t)subdblen); 2145 subdb[subdblen] = '\0'; 2146 } 2147 subdbtmp = Tcl_GetByteArrayFromObj(objv[i++], &newlen); 2148 if ((ret = __os_malloc( 2149 dbenv->env, (size_t)newlen + 1, &newname)) != 0) { 2150 Tcl_SetResult(interp, 2151 db_strerror(ret), TCL_STATIC); 2152 return (0); 2153 } 2154 memcpy(newname, subdbtmp, (size_t)newlen); 2155 newname[newlen] = '\0'; 2156 } else { 2157 Tcl_WrongNumArgs(interp, 3, objv, 2158 "?args? filename ?database? ?newname?"); 2159 result = TCL_ERROR; 2160 goto error; 2161 } 2162 ret = dbenv->dbrename(dbenv, txn, db, subdb, newname, flag); 2163 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 2164 "env dbrename"); 2165error: 2166 if (subdb) 2167 __os_free(dbenv->env, subdb); 2168 if (newname) 2169 __os_free(dbenv->env, newname); 2170 return (result); 2171} 2172 2173/* 2174 * env_GetFlags -- 2175 * Implements the ENV->get_flags command. 2176 */ 2177static int 2178env_GetFlags(interp, objc, objv, dbenv) 2179 Tcl_Interp *interp; /* Interpreter */ 2180 int objc; /* How many arguments? */ 2181 Tcl_Obj *CONST objv[]; /* The argument objects */ 2182 DB_ENV *dbenv; 2183{ 2184 int i, ret, result; 2185 u_int32_t flags; 2186 char buf[512]; 2187 Tcl_Obj *res; 2188 2189 static const struct { 2190 u_int32_t flag; 2191 char *arg; 2192 } open_flags[] = { 2193 { DB_AUTO_COMMIT, "-auto_commit" }, 2194 { DB_CDB_ALLDB, "-cdb_alldb" }, 2195 { DB_DIRECT_DB, "-direct_db" }, 2196 { DB_MULTIVERSION, "-multiversion" }, 2197 { DB_NOLOCKING, "-nolock" }, 2198 { DB_NOMMAP, "-nommap" }, 2199 { DB_NOPANIC, "-nopanic" }, 2200 { DB_OVERWRITE, "-overwrite" }, 2201 { DB_PANIC_ENVIRONMENT, "-panic" }, 2202 { DB_REGION_INIT, "-region_init" }, 2203 { DB_TXN_NOSYNC, "-nosync" }, 2204 { DB_TXN_WRITE_NOSYNC, "-wrnosync" }, 2205 { DB_YIELDCPU, "-yield" }, 2206 { 0, NULL } 2207 }; 2208 2209 if (objc != 2) { 2210 Tcl_WrongNumArgs(interp, 1, objv, NULL); 2211 return (TCL_ERROR); 2212 } 2213 2214 ret = dbenv->get_flags(dbenv, &flags); 2215 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 2216 "env get_flags")) == TCL_OK) { 2217 buf[0] = '\0'; 2218 2219 for (i = 0; open_flags[i].flag != 0; i++) 2220 if (LF_ISSET(open_flags[i].flag)) { 2221 if (strlen(buf) > 0) 2222 (void)strncat(buf, " ", sizeof(buf)); 2223 (void)strncat( 2224 buf, open_flags[i].arg, sizeof(buf)); 2225 } 2226 2227 res = NewStringObj(buf, strlen(buf)); 2228 Tcl_SetObjResult(interp, res); 2229 } 2230 2231 return (result); 2232} 2233 2234/* 2235 * env_GetOpenFlag -- 2236 * Implements the ENV->get_open_flags command. 2237 */ 2238static int 2239env_GetOpenFlag(interp, objc, objv, dbenv) 2240 Tcl_Interp *interp; /* Interpreter */ 2241 int objc; /* How many arguments? */ 2242 Tcl_Obj *CONST objv[]; /* The argument objects */ 2243 DB_ENV *dbenv; 2244{ 2245 int i, ret, result; 2246 u_int32_t flags; 2247 char buf[512]; 2248 Tcl_Obj *res; 2249 2250 static const struct { 2251 u_int32_t flag; 2252 char *arg; 2253 } open_flags[] = { 2254 { DB_CREATE, "-create" }, 2255 { DB_INIT_CDB, "-cdb" }, 2256 { DB_INIT_LOCK, "-lock" }, 2257 { DB_INIT_LOG, "-log" }, 2258 { DB_INIT_MPOOL, "-mpool" }, 2259 { DB_INIT_TXN, "-txn" }, 2260 { DB_LOCKDOWN, "-lockdown" }, 2261 { DB_PRIVATE, "-private" }, 2262 { DB_RECOVER, "-recover" }, 2263 { DB_RECOVER_FATAL, "-recover_fatal" }, 2264 { DB_REGISTER, "-register" }, 2265 { DB_SYSTEM_MEM, "-system_mem" }, 2266 { DB_THREAD, "-thread" }, 2267 { DB_USE_ENVIRON, "-use_environ" }, 2268 { DB_USE_ENVIRON_ROOT, "-use_environ_root" }, 2269 { 0, NULL } 2270 }; 2271 2272 if (objc != 2) { 2273 Tcl_WrongNumArgs(interp, 1, objv, NULL); 2274 return (TCL_ERROR); 2275 } 2276 2277 ret = dbenv->get_open_flags(dbenv, &flags); 2278 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 2279 "env get_open_flags")) == TCL_OK) { 2280 buf[0] = '\0'; 2281 2282 for (i = 0; open_flags[i].flag != 0; i++) 2283 if (LF_ISSET(open_flags[i].flag)) { 2284 if (strlen(buf) > 0) 2285 (void)strncat(buf, " ", sizeof(buf)); 2286 (void)strncat( 2287 buf, open_flags[i].arg, sizeof(buf)); 2288 } 2289 2290 res = NewStringObj(buf, strlen(buf)); 2291 Tcl_SetObjResult(interp, res); 2292 } 2293 2294 return (result); 2295} 2296 2297/* 2298 * PUBLIC: int tcl_EnvGetEncryptFlags __P((Tcl_Interp *, int, Tcl_Obj * CONST*, 2299 * PUBLIC: DB_ENV *)); 2300 * 2301 * tcl_EnvGetEncryptFlags -- 2302 * Implements the ENV->get_encrypt_flags command. 2303 */ 2304int 2305tcl_EnvGetEncryptFlags(interp, objc, objv, dbenv) 2306 Tcl_Interp *interp; /* Interpreter */ 2307 int objc; /* How many arguments? */ 2308 Tcl_Obj *CONST objv[]; /* The argument objects */ 2309 DB_ENV *dbenv; /* Database pointer */ 2310{ 2311 int i, ret, result; 2312 u_int32_t flags; 2313 char buf[512]; 2314 Tcl_Obj *res; 2315 2316 static const struct { 2317 u_int32_t flag; 2318 char *arg; 2319 } encrypt_flags[] = { 2320 { DB_ENCRYPT_AES, "-encryptaes" }, 2321 { 0, NULL } 2322 }; 2323 2324 if (objc != 2) { 2325 Tcl_WrongNumArgs(interp, 1, objv, NULL); 2326 return (TCL_ERROR); 2327 } 2328 2329 ret = dbenv->get_encrypt_flags(dbenv, &flags); 2330 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 2331 "env get_encrypt_flags")) == TCL_OK) { 2332 buf[0] = '\0'; 2333 2334 for (i = 0; encrypt_flags[i].flag != 0; i++) 2335 if (LF_ISSET(encrypt_flags[i].flag)) { 2336 if (strlen(buf) > 0) 2337 (void)strncat(buf, " ", sizeof(buf)); 2338 (void)strncat( 2339 buf, encrypt_flags[i].arg, sizeof(buf)); 2340 } 2341 2342 res = NewStringObj(buf, strlen(buf)); 2343 Tcl_SetObjResult(interp, res); 2344 } 2345 2346 return (result); 2347} 2348 2349/* 2350 * env_GetLockDetect -- 2351 * Implements the ENV->get_lk_detect command. 2352 */ 2353static int 2354env_GetLockDetect(interp, objc, objv, dbenv) 2355 Tcl_Interp *interp; /* Interpreter */ 2356 int objc; /* How many arguments? */ 2357 Tcl_Obj *CONST objv[]; /* The argument objects */ 2358 DB_ENV *dbenv; 2359{ 2360 int i, ret, result; 2361 u_int32_t lk_detect; 2362 const char *answer; 2363 Tcl_Obj *res; 2364 static const struct { 2365 u_int32_t flag; 2366 char *name; 2367 } lk_detect_returns[] = { 2368 { DB_LOCK_DEFAULT, "default" }, 2369 { DB_LOCK_EXPIRE, "expire" }, 2370 { DB_LOCK_MAXLOCKS, "maxlocks" }, 2371 { DB_LOCK_MAXWRITE, "maxwrite" }, 2372 { DB_LOCK_MINLOCKS, "minlocks" }, 2373 { DB_LOCK_MINWRITE, "minwrite" }, 2374 { DB_LOCK_OLDEST, "oldest" }, 2375 { DB_LOCK_RANDOM, "random" }, 2376 { DB_LOCK_YOUNGEST, "youngest" }, 2377 { 0, NULL } 2378 }; 2379 2380 if (objc != 2) { 2381 Tcl_WrongNumArgs(interp, 1, objv, NULL); 2382 return (TCL_ERROR); 2383 } 2384 ret = dbenv->get_lk_detect(dbenv, &lk_detect); 2385 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 2386 "env get_lk_detect")) == TCL_OK) { 2387 answer = "unknown"; 2388 for (i = 0; lk_detect_returns[i].flag != 0; i++) 2389 if (lk_detect == lk_detect_returns[i].flag) 2390 answer = lk_detect_returns[i].name; 2391 2392 res = NewStringObj(answer, strlen(answer)); 2393 Tcl_SetObjResult(interp, res); 2394 } 2395 2396 return (result); 2397} 2398 2399/* 2400 * env_GetTimeout -- 2401 * Implements the ENV->get_timeout command. 2402 */ 2403static int 2404env_GetTimeout(interp, objc, objv, dbenv) 2405 Tcl_Interp *interp; /* Interpreter */ 2406 int objc; /* How many arguments? */ 2407 Tcl_Obj *CONST objv[]; /* The argument objects */ 2408 DB_ENV *dbenv; 2409{ 2410 static const struct { 2411 u_int32_t flag; 2412 char *arg; 2413 } timeout_flags[] = { 2414 { DB_SET_TXN_TIMEOUT, "txn" }, 2415 { DB_SET_LOCK_TIMEOUT, "lock" }, 2416 { 0, NULL } 2417 }; 2418 Tcl_Obj *res; 2419 db_timeout_t timeout; 2420 u_int32_t which; 2421 int i, ret, result; 2422 const char *arg; 2423 2424 COMPQUIET(timeout, 0); 2425 2426 if (objc != 3) { 2427 Tcl_WrongNumArgs(interp, 1, objv, NULL); 2428 return (TCL_ERROR); 2429 } 2430 2431 arg = Tcl_GetStringFromObj(objv[2], NULL); 2432 which = 0; 2433 for (i = 0; timeout_flags[i].flag != 0; i++) 2434 if (strcmp(arg, timeout_flags[i].arg) == 0) 2435 which = timeout_flags[i].flag; 2436 if (which == 0) { 2437 ret = EINVAL; 2438 goto err; 2439 } 2440 2441 ret = dbenv->get_timeout(dbenv, &timeout, which); 2442err: if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 2443 "env get_timeout")) == TCL_OK) { 2444 res = Tcl_NewLongObj((long)timeout); 2445 Tcl_SetObjResult(interp, res); 2446 } 2447 2448 return (result); 2449} 2450 2451/* 2452 * env_GetVerbose -- 2453 * Implements the ENV->get_open_flags command. 2454 */ 2455static int 2456env_GetVerbose(interp, objc, objv, dbenv) 2457 Tcl_Interp *interp; /* Interpreter */ 2458 int objc; /* How many arguments? */ 2459 Tcl_Obj *CONST objv[]; /* The argument objects */ 2460 DB_ENV *dbenv; 2461{ 2462 static const struct { 2463 u_int32_t flag; 2464 char *arg; 2465 } verbose_flags[] = { 2466 { DB_VERB_DEADLOCK, "deadlock" }, 2467 { DB_VERB_FILEOPS, "fileops" }, 2468 { DB_VERB_FILEOPS_ALL, "fileops_all" }, 2469 { DB_VERB_RECOVERY, "recovery" }, 2470 { DB_VERB_REGISTER, "register" }, 2471 { DB_VERB_REPLICATION, "rep" }, 2472 { DB_VERB_REP_ELECT, "rep_elect" }, 2473 { DB_VERB_REP_LEASE, "rep_lease" }, 2474 { DB_VERB_REP_MISC, "rep_misc" }, 2475 { DB_VERB_REP_MSGS, "rep_msgs" }, 2476 { DB_VERB_REP_SYNC, "rep_sync" }, 2477 { DB_VERB_REPMGR_CONNFAIL, "repmgr_connfail" }, 2478 { DB_VERB_REPMGR_MISC, "repmgr_misc" }, 2479 { DB_VERB_WAITSFOR, "wait" }, 2480 { 0, NULL } 2481 }; 2482 Tcl_Obj *res; 2483 u_int32_t which; 2484 int i, onoff, ret, result; 2485 const char *arg, *answer; 2486 2487 COMPQUIET(onoff, 0); 2488 2489 if (objc != 3) { 2490 Tcl_WrongNumArgs(interp, 1, objv, NULL); 2491 return (TCL_ERROR); 2492 } 2493 2494 arg = Tcl_GetStringFromObj(objv[2], NULL); 2495 which = 0; 2496 for (i = 0; verbose_flags[i].flag != 0; i++) 2497 if (strcmp(arg, verbose_flags[i].arg) == 0) 2498 which = verbose_flags[i].flag; 2499 if (which == 0) { 2500 ret = EINVAL; 2501 goto err; 2502 } 2503 2504 ret = dbenv->get_verbose(dbenv, which, &onoff); 2505err: if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 2506 "env get_verbose")) == 0) { 2507 answer = onoff ? "on" : "off"; 2508 res = NewStringObj(answer, strlen(answer)); 2509 Tcl_SetObjResult(interp, res); 2510 } 2511 2512 return (result); 2513} 2514 2515/* 2516 * PUBLIC: void tcl_EnvSetErrfile __P((Tcl_Interp *, DB_ENV *, DBTCL_INFO *, 2517 * PUBLIC: char *)); 2518 * 2519 * tcl_EnvSetErrfile -- 2520 * Implements the ENV->set_errfile command. 2521 */ 2522void 2523tcl_EnvSetErrfile(interp, dbenv, ip, errf) 2524 Tcl_Interp *interp; /* Interpreter */ 2525 DB_ENV *dbenv; /* Database pointer */ 2526 DBTCL_INFO *ip; /* Our internal info */ 2527 char *errf; 2528{ 2529 COMPQUIET(interp, NULL); 2530 /* 2531 * If the user already set one, free it. 2532 */ 2533 if (ip->i_err != NULL && ip->i_err != stdout && 2534 ip->i_err != stderr) 2535 (void)fclose(ip->i_err); 2536 if (strcmp(errf, "/dev/stdout") == 0) 2537 ip->i_err = stdout; 2538 else if (strcmp(errf, "/dev/stderr") == 0) 2539 ip->i_err = stderr; 2540 else 2541 ip->i_err = fopen(errf, "a"); 2542 if (ip->i_err != NULL) 2543 dbenv->set_errfile(dbenv, ip->i_err); 2544} 2545 2546/* 2547 * PUBLIC: int tcl_EnvSetErrpfx __P((Tcl_Interp *, DB_ENV *, DBTCL_INFO *, 2548 * PUBLIC: char *)); 2549 * 2550 * tcl_EnvSetErrpfx -- 2551 * Implements the ENV->set_errpfx command. 2552 */ 2553int 2554tcl_EnvSetErrpfx(interp, dbenv, ip, pfx) 2555 Tcl_Interp *interp; /* Interpreter */ 2556 DB_ENV *dbenv; /* Database pointer */ 2557 DBTCL_INFO *ip; /* Our internal info */ 2558 char *pfx; 2559{ 2560 int result, ret; 2561 2562 /* 2563 * Assume success. The only thing that can fail is 2564 * the __os_strdup. 2565 */ 2566 result = TCL_OK; 2567 Tcl_SetResult(interp, "0", TCL_STATIC); 2568 /* 2569 * If the user already set one, free it. 2570 */ 2571 if (ip->i_errpfx != NULL) 2572 __os_free(dbenv->env, ip->i_errpfx); 2573 if ((ret = __os_strdup(dbenv->env, pfx, &ip->i_errpfx)) != 0) { 2574 result = _ReturnSetup(interp, ret, 2575 DB_RETOK_STD(ret), "__os_strdup"); 2576 ip->i_errpfx = NULL; 2577 } 2578 if (ip->i_errpfx != NULL) 2579 dbenv->set_errpfx(dbenv, ip->i_errpfx); 2580 return (result); 2581} 2582