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