1/*- 2 * See the file LICENSE for redistribution information. 3 * 4 * Copyright (c) 1999,2008 Oracle. All rights reserved. 5 * 6 * $Id: tcl_db_pkg.c,v 12.62 2008/03/13 17:48:30 mbrey Exp $ 7 */ 8 9#include "db_config.h" 10 11#ifdef CONFIG_TEST 12#define DB_DBM_HSEARCH 1 13#endif 14 15#include "db_int.h" 16#ifdef HAVE_SYSTEM_INCLUDE_FILES 17#include <tcl.h> 18#endif 19#include "dbinc/db_page.h" 20#include "dbinc/hash.h" 21#include "dbinc/tcl_db.h" 22 23/* XXX we must declare global data in just one place */ 24DBTCL_GLOBAL __dbtcl_global; 25 26/* 27 * Prototypes for procedures defined later in this file: 28 */ 29static int berkdb_Cmd __P((ClientData, Tcl_Interp *, int, 30 Tcl_Obj * CONST*)); 31static int bdb_EnvOpen __P((Tcl_Interp *, int, Tcl_Obj * CONST*, 32 DBTCL_INFO *, DB_ENV **)); 33static int bdb_DbOpen __P((Tcl_Interp *, int, Tcl_Obj * CONST*, 34 DBTCL_INFO *, DB **)); 35static int bdb_DbRemove __P((Tcl_Interp *, int, Tcl_Obj * CONST*)); 36static int bdb_DbRename __P((Tcl_Interp *, int, Tcl_Obj * CONST*)); 37static int bdb_Version __P((Tcl_Interp *, int, Tcl_Obj * CONST*)); 38 39#ifdef HAVE_64BIT_TYPES 40static int bdb_SeqOpen __P((Tcl_Interp *, int, Tcl_Obj * CONST*, 41 DBTCL_INFO *, DB_SEQUENCE **)); 42#endif 43 44#ifdef CONFIG_TEST 45static int bdb_DbUpgrade __P((Tcl_Interp *, int, Tcl_Obj * CONST*)); 46static int bdb_DbVerify __P((Tcl_Interp *, int, Tcl_Obj * CONST*)); 47static int bdb_GetConfig __P((Tcl_Interp *, int, Tcl_Obj * CONST*)); 48static int bdb_Handles __P((Tcl_Interp *, int, Tcl_Obj * CONST*)); 49static int bdb_MsgType __P((Tcl_Interp *, int, Tcl_Obj * CONST*)); 50 51static int tcl_bt_compare __P((DB *, const DBT *, const DBT *)); 52static int tcl_compare_callback __P((DB *, const DBT *, const DBT *, 53 Tcl_Obj *, char *)); 54static void tcl_db_free __P((void *)); 55static void * tcl_db_malloc __P((size_t)); 56static void * tcl_db_realloc __P((void *, size_t)); 57static int tcl_dup_compare __P((DB *, const DBT *, const DBT *)); 58static u_int32_t tcl_h_hash __P((DB *, const void *, u_int32_t)); 59#endif 60 61int Db_tcl_Init __P((Tcl_Interp *)); 62 63/* 64 * Db_tcl_Init -- 65 * 66 * This is a package initialization procedure, which is called by Tcl when 67 * this package is to be added to an interpreter. The name is based on the 68 * name of the shared library, currently libdb_tcl-X.Y.so, which Tcl uses 69 * to determine the name of this function. 70 */ 71int 72Db_tcl_Init(interp) 73 Tcl_Interp *interp; /* Interpreter in which the package is 74 * to be made available. */ 75{ 76 int code; 77 char pkg[12]; 78 79 snprintf(pkg, sizeof(pkg), "%d.%d", DB_VERSION_MAJOR, DB_VERSION_MINOR); 80 code = Tcl_PkgProvide(interp, "Db_tcl", pkg); 81 if (code != TCL_OK) 82 return (code); 83 84 /* 85 * Don't allow setuid/setgid scripts for the Tcl API because some Tcl 86 * functions evaluate the arguments and could otherwise allow a user 87 * to inject Tcl commands. 88 */ 89#if defined(HAVE_SETUID) && defined(HAVE_GETUID) 90 (void)setuid(getuid()); 91#endif 92#if defined(HAVE_SETGID) && defined(HAVE_GETGID) 93 (void)setgid(getgid()); 94#endif 95 96 (void)Tcl_CreateObjCommand(interp, 97 "berkdb", (Tcl_ObjCmdProc *)berkdb_Cmd, (ClientData)0, NULL); 98 /* 99 * Create shared global debugging variables 100 */ 101 (void)Tcl_LinkVar( 102 interp, "__debug_on", (char *)&__debug_on, TCL_LINK_INT); 103 (void)Tcl_LinkVar( 104 interp, "__debug_print", (char *)&__debug_print, TCL_LINK_INT); 105 (void)Tcl_LinkVar( 106 interp, "__debug_stop", (char *)&__debug_stop, TCL_LINK_INT); 107 (void)Tcl_LinkVar( 108 interp, "__debug_test", (char *)&__debug_test, 109 TCL_LINK_INT); 110 LIST_INIT(&__db_infohead); 111 return (TCL_OK); 112} 113 114/* 115 * berkdb_cmd -- 116 * Implements the "berkdb" command. 117 * This command supports three sub commands: 118 * berkdb version - Returns a list {major minor patch} 119 * berkdb env - Creates a new DB_ENV and returns a binding 120 * to a new command of the form dbenvX, where X is an 121 * integer starting at 0 (dbenv0, dbenv1, ...) 122 * berkdb open - Creates a new DB (optionally within 123 * the given environment. Returns a binding to a new 124 * command of the form dbX, where X is an integer 125 * starting at 0 (db0, db1, ...) 126 */ 127static int 128berkdb_Cmd(notused, interp, objc, objv) 129 ClientData notused; /* Not used. */ 130 Tcl_Interp *interp; /* Interpreter */ 131 int objc; /* How many arguments? */ 132 Tcl_Obj *CONST objv[]; /* The argument objects */ 133{ 134 static const char *berkdbcmds[] = { 135#ifdef CONFIG_TEST 136 "dbverify", 137 "getconfig", 138 "handles", 139 "msgtype", 140 "upgrade", 141#endif 142 "dbremove", 143 "dbrename", 144 "env", 145 "envremove", 146 "open", 147#ifdef HAVE_64BIT_TYPES 148 "sequence", 149#endif 150 "version", 151#ifdef CONFIG_TEST 152 /* All below are compatibility functions */ 153 "hcreate", "hsearch", "hdestroy", 154 "dbminit", "fetch", "store", 155 "delete", "firstkey", "nextkey", 156 "ndbm_open", "dbmclose", 157#endif 158 /* All below are convenience functions */ 159 "rand", "random_int", "srand", 160 "debug_check", 161 NULL 162 }; 163 /* 164 * All commands enums below ending in X are compatibility 165 */ 166 enum berkdbcmds { 167#ifdef CONFIG_TEST 168 BDB_DBVERIFY, 169 BDB_GETCONFIG, 170 BDB_HANDLES, 171 BDB_MSGTYPE, 172 BDB_UPGRADE, 173#endif 174 BDB_DBREMOVE, 175 BDB_DBRENAME, 176 BDB_ENV, 177 BDB_ENVREMOVE, 178 BDB_OPEN, 179#ifdef HAVE_64BIT_TYPES 180 BDB_SEQUENCE, 181#endif 182 BDB_VERSION, 183#ifdef CONFIG_TEST 184 BDB_HCREATEX, BDB_HSEARCHX, BDB_HDESTROYX, 185 BDB_DBMINITX, BDB_FETCHX, BDB_STOREX, 186 BDB_DELETEX, BDB_FIRSTKEYX, BDB_NEXTKEYX, 187 BDB_NDBMOPENX, BDB_DBMCLOSEX, 188#endif 189 BDB_RANDX, BDB_RAND_INTX, BDB_SRANDX, 190 BDB_DBGCKX 191 }; 192 static int env_id = 0; 193 static int db_id = 0; 194#ifdef HAVE_64BIT_TYPES 195 static int seq_id = 0; 196#endif 197 198 DB *dbp; 199#ifdef HAVE_64BIT_TYPES 200 DB_SEQUENCE *seq; 201#endif 202#ifdef CONFIG_TEST 203 DBM *ndbmp; 204 static int ndbm_id = 0; 205#endif 206 DBTCL_INFO *ip; 207 DB_ENV *dbenv; 208 Tcl_Obj *res; 209 int cmdindex, result; 210 char newname[MSG_SIZE]; 211 212 COMPQUIET(notused, NULL); 213 214 Tcl_ResetResult(interp); 215 memset(newname, 0, MSG_SIZE); 216 result = TCL_OK; 217 if (objc <= 1) { 218 Tcl_WrongNumArgs(interp, 1, objv, "command cmdargs"); 219 return (TCL_ERROR); 220 } 221 222 /* 223 * Get the command name index from the object based on the berkdbcmds 224 * defined above. 225 */ 226 if (Tcl_GetIndexFromObj(interp, 227 objv[1], berkdbcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK) 228 return (IS_HELP(objv[1])); 229 res = NULL; 230 switch ((enum berkdbcmds)cmdindex) { 231#ifdef CONFIG_TEST 232 case BDB_DBVERIFY: 233 result = bdb_DbVerify(interp, objc, objv); 234 break; 235 case BDB_GETCONFIG: 236 result = bdb_GetConfig(interp, objc, objv); 237 break; 238 case BDB_HANDLES: 239 result = bdb_Handles(interp, objc, objv); 240 break; 241 case BDB_MSGTYPE: 242 result = bdb_MsgType(interp, objc, objv); 243 break; 244 case BDB_UPGRADE: 245 result = bdb_DbUpgrade(interp, objc, objv); 246 break; 247#endif 248 case BDB_VERSION: 249 _debug_check(); 250 result = bdb_Version(interp, objc, objv); 251 break; 252 case BDB_ENV: 253 snprintf(newname, sizeof(newname), "env%d", env_id); 254 ip = _NewInfo(interp, NULL, newname, I_ENV); 255 if (ip != NULL) { 256 result = bdb_EnvOpen(interp, objc, objv, ip, &dbenv); 257 if (result == TCL_OK && dbenv != NULL) { 258 env_id++; 259 (void)Tcl_CreateObjCommand(interp, newname, 260 (Tcl_ObjCmdProc *)env_Cmd, 261 (ClientData)dbenv, NULL); 262 /* Use ip->i_name - newname is overwritten */ 263 res = NewStringObj(newname, strlen(newname)); 264 _SetInfoData(ip, dbenv); 265 } else 266 _DeleteInfo(ip); 267 } else { 268 Tcl_SetResult(interp, "Could not set up info", 269 TCL_STATIC); 270 result = TCL_ERROR; 271 } 272 break; 273 case BDB_DBREMOVE: 274 result = bdb_DbRemove(interp, objc, objv); 275 break; 276 case BDB_DBRENAME: 277 result = bdb_DbRename(interp, objc, objv); 278 break; 279 case BDB_ENVREMOVE: 280 result = tcl_EnvRemove(interp, objc, objv, NULL, NULL); 281 break; 282 case BDB_OPEN: 283 snprintf(newname, sizeof(newname), "db%d", db_id); 284 ip = _NewInfo(interp, NULL, newname, I_DB); 285 if (ip != NULL) { 286 result = bdb_DbOpen(interp, objc, objv, ip, &dbp); 287 if (result == TCL_OK && dbp != NULL) { 288 db_id++; 289 (void)Tcl_CreateObjCommand(interp, newname, 290 (Tcl_ObjCmdProc *)db_Cmd, 291 (ClientData)dbp, NULL); 292 /* Use ip->i_name - newname is overwritten */ 293 res = NewStringObj(newname, strlen(newname)); 294 _SetInfoData(ip, dbp); 295 } else 296 _DeleteInfo(ip); 297 } else { 298 Tcl_SetResult(interp, "Could not set up info", 299 TCL_STATIC); 300 result = TCL_ERROR; 301 } 302 break; 303#ifdef HAVE_64BIT_TYPES 304 case BDB_SEQUENCE: 305 snprintf(newname, sizeof(newname), "seq%d", seq_id); 306 ip = _NewInfo(interp, NULL, newname, I_SEQ); 307 if (ip != NULL) { 308 result = bdb_SeqOpen(interp, objc, objv, ip, &seq); 309 if (result == TCL_OK && seq != NULL) { 310 seq_id++; 311 (void)Tcl_CreateObjCommand(interp, newname, 312 (Tcl_ObjCmdProc *)seq_Cmd, 313 (ClientData)seq, NULL); 314 /* Use ip->i_name - newname is overwritten */ 315 res = NewStringObj(newname, strlen(newname)); 316 _SetInfoData(ip, seq); 317 } else 318 _DeleteInfo(ip); 319 } else { 320 Tcl_SetResult(interp, "Could not set up info", 321 TCL_STATIC); 322 result = TCL_ERROR; 323 } 324 break; 325#endif 326#ifdef CONFIG_TEST 327 case BDB_HCREATEX: 328 case BDB_HSEARCHX: 329 case BDB_HDESTROYX: 330 result = bdb_HCommand(interp, objc, objv); 331 break; 332 case BDB_DBMINITX: 333 case BDB_DBMCLOSEX: 334 case BDB_FETCHX: 335 case BDB_STOREX: 336 case BDB_DELETEX: 337 case BDB_FIRSTKEYX: 338 case BDB_NEXTKEYX: 339 result = bdb_DbmCommand(interp, objc, objv, DBTCL_DBM, NULL); 340 break; 341 case BDB_NDBMOPENX: 342 snprintf(newname, sizeof(newname), "ndbm%d", ndbm_id); 343 ip = _NewInfo(interp, NULL, newname, I_NDBM); 344 if (ip != NULL) { 345 result = bdb_NdbmOpen(interp, objc, objv, &ndbmp); 346 if (result == TCL_OK) { 347 ndbm_id++; 348 (void)Tcl_CreateObjCommand(interp, newname, 349 (Tcl_ObjCmdProc *)ndbm_Cmd, 350 (ClientData)ndbmp, NULL); 351 /* Use ip->i_name - newname is overwritten */ 352 res = NewStringObj(newname, strlen(newname)); 353 _SetInfoData(ip, ndbmp); 354 } else 355 _DeleteInfo(ip); 356 } else { 357 Tcl_SetResult(interp, "Could not set up info", 358 TCL_STATIC); 359 result = TCL_ERROR; 360 } 361 break; 362#endif 363 case BDB_RANDX: 364 case BDB_RAND_INTX: 365 case BDB_SRANDX: 366 result = bdb_RandCommand(interp, objc, objv); 367 break; 368 case BDB_DBGCKX: 369 _debug_check(); 370 res = Tcl_NewIntObj(0); 371 break; 372 } 373 /* 374 * For each different arg call different function to create 375 * new commands (or if version, get/return it). 376 */ 377 if (result == TCL_OK && res != NULL) 378 Tcl_SetObjResult(interp, res); 379 return (result); 380} 381 382/* 383 * bdb_EnvOpen - 384 * Implements the environment open command. 385 * There are many, many options to the open command. 386 * Here is the general flow: 387 * 388 * 1. Call db_env_create to create the env handle. 389 * 2. Parse args tracking options. 390 * 3. Make any pre-open setup calls necessary. 391 * 4. Call DB_ENV->open to open the env. 392 * 5. Return env widget handle to user. 393 */ 394static int 395bdb_EnvOpen(interp, objc, objv, ip, dbenvp) 396 Tcl_Interp *interp; /* Interpreter */ 397 int objc; /* How many arguments? */ 398 Tcl_Obj *CONST objv[]; /* The argument objects */ 399 DBTCL_INFO *ip; /* Our internal info */ 400 DB_ENV **dbenvp; /* Environment pointer */ 401{ 402 static const char *envopen[] = { 403#ifdef CONFIG_TEST 404 "-alloc", 405 "-auto_commit", 406 "-cdb", 407 "-cdb_alldb", 408 "-client_timeout", 409 "-event", 410 "-lock", 411 "-lock_conflict", 412 "-lock_detect", 413 "-lock_max_locks", 414 "-lock_max_lockers", 415 "-lock_max_objects", 416 "-lock_partitions", 417 "-lock_timeout", 418 "-log", 419 "-log_filemode", 420 "-log_buffer", 421 "-log_inmemory", 422 "-log_max", 423 "-log_regionmax", 424 "-log_remove", 425 "-mpool_max_openfd", 426 "-mpool_max_write", 427 "-mpool_mmap_size", 428 "-mpool_nommap", 429 "-multiversion", 430 "-overwrite", 431 "-region_init", 432 "-rep", 433 "-rep_client", 434 "-rep_lease", 435 "-rep_master", 436 "-rep_transport", 437 "-server", 438 "-server_timeout", 439 "-set_intermediate_dir_mode", 440 "-snapshot", 441 "-thread", 442 "-time_notgranted", 443 "-txn_nowait", 444 "-txn_timeout", 445 "-txn_timestamp", 446 "-verbose", 447 "-wrnosync", 448 "-zero_log", 449#endif 450 "-cachesize", 451 "-cache_max", 452 "-create", 453 "-data_dir", 454 "-encryptaes", 455 "-encryptany", 456 "-errfile", 457 "-errpfx", 458 "-home", 459 "-log_dir", 460 "-mode", 461 "-private", 462 "-recover", 463 "-recover_fatal", 464 "-register", 465 "-shm_key", 466 "-system_mem", 467 "-tmp_dir", 468 "-txn", 469 "-txn_max", 470 "-use_environ", 471 "-use_environ_root", 472 NULL 473 }; 474 /* 475 * !!! 476 * These have to be in the same order as the above, 477 * which is close to but not quite alphabetical. 478 */ 479 enum envopen { 480#ifdef CONFIG_TEST 481 TCL_ENV_ALLOC, 482 TCL_ENV_AUTO_COMMIT, 483 TCL_ENV_CDB, 484 TCL_ENV_CDB_ALLDB, 485 TCL_ENV_CLIENT_TO, 486 TCL_ENV_EVENT, 487 TCL_ENV_LOCK, 488 TCL_ENV_CONFLICT, 489 TCL_ENV_DETECT, 490 TCL_ENV_LOCK_MAX_LOCKS, 491 TCL_ENV_LOCK_MAX_LOCKERS, 492 TCL_ENV_LOCK_MAX_OBJECTS, 493 TCL_ENV_LOCK_PARTITIONS, 494 TCL_ENV_LOCK_TIMEOUT, 495 TCL_ENV_LOG, 496 TCL_ENV_LOG_FILEMODE, 497 TCL_ENV_LOG_BUFFER, 498 TCL_ENV_LOG_INMEMORY, 499 TCL_ENV_LOG_MAX, 500 TCL_ENV_LOG_REGIONMAX, 501 TCL_ENV_LOG_REMOVE, 502 TCL_ENV_MPOOL_MAX_OPENFD, 503 TCL_ENV_MPOOL_MAX_WRITE, 504 TCL_ENV_MPOOL_MMAP_SIZE, 505 TCL_ENV_MPOOL_NOMMAP, 506 TCL_ENV_MULTIVERSION, 507 TCL_ENV_OVERWRITE, 508 TCL_ENV_REGION_INIT, 509 TCL_ENV_REP, 510 TCL_ENV_REP_CLIENT, 511 TCL_ENV_REP_LEASE, 512 TCL_ENV_REP_MASTER, 513 TCL_ENV_REP_TRANSPORT, 514 TCL_ENV_SERVER, 515 TCL_ENV_SERVER_TO, 516 TCL_ENV_SET_INTERMEDIATE_DIR, 517 TCL_ENV_SNAPSHOT, 518 TCL_ENV_THREAD, 519 TCL_ENV_TIME_NOTGRANTED, 520 TCL_ENV_TXN_NOWAIT, 521 TCL_ENV_TXN_TIMEOUT, 522 TCL_ENV_TXN_TIME, 523 TCL_ENV_VERBOSE, 524 TCL_ENV_WRNOSYNC, 525 TCL_ENV_ZEROLOG, 526#endif 527 TCL_ENV_CACHESIZE, 528 TCL_ENV_CACHE_MAX, 529 TCL_ENV_CREATE, 530 TCL_ENV_DATA_DIR, 531 TCL_ENV_ENCRYPT_AES, 532 TCL_ENV_ENCRYPT_ANY, 533 TCL_ENV_ERRFILE, 534 TCL_ENV_ERRPFX, 535 TCL_ENV_HOME, 536 TCL_ENV_LOG_DIR, 537 TCL_ENV_MODE, 538 TCL_ENV_PRIVATE, 539 TCL_ENV_RECOVER, 540 TCL_ENV_RECOVER_FATAL, 541 TCL_ENV_REGISTER, 542 TCL_ENV_SHM_KEY, 543 TCL_ENV_SYSTEM_MEM, 544 TCL_ENV_TMP_DIR, 545 TCL_ENV_TXN, 546 TCL_ENV_TXN_MAX, 547 TCL_ENV_USE_ENVIRON, 548 TCL_ENV_USE_ENVIRON_ROOT 549 }; 550 DB_ENV *dbenv; 551 Tcl_Obj **myobjv; 552 u_int32_t cr_flags, gbytes, bytes, logbufset, logmaxset; 553 u_int32_t open_flags, rep_flags, set_flags, uintarg; 554 int i, mode, myobjc, ncaches, optindex, result, ret; 555 long client_to, server_to, shm; 556 char *arg, *home, *passwd, *server; 557#ifdef CONFIG_TEST 558 Tcl_Obj **myobjv1; 559 time_t timestamp; 560 long v; 561 u_int32_t detect; 562 u_int8_t *conflicts; 563 int intarg, intarg2, j, nmodes, temp; 564#endif 565 566 result = TCL_OK; 567 mode = 0; 568 rep_flags = set_flags = cr_flags = 0; 569 home = NULL; 570 571 /* 572 * XXX 573 * If/when our Tcl interface becomes thread-safe, we should enable 574 * DB_THREAD here in all cases. For now, we turn it on later in this 575 * function, and only when we're in testing and we specify the 576 * -thread flag, so that we can exercise MUTEX_THREAD_LOCK cases. 577 * 578 * In order to become truly thread-safe, we need to look at making sure 579 * DBTCL_INFO structs are safe to share across threads (they're not 580 * mutex-protected) before we declare the Tcl interface thread-safe. 581 * Meanwhile, there's no strong reason to enable DB_THREAD when not 582 * testing. 583 */ 584 open_flags = 0; 585 logmaxset = logbufset = 0; 586 587 if (objc <= 2) { 588 Tcl_WrongNumArgs(interp, 2, objv, "?args?"); 589 return (TCL_ERROR); 590 } 591 592 /* 593 * Server code must go before the call to db_env_create. 594 */ 595 server = NULL; 596 server_to = client_to = 0; 597 i = 2; 598 while (i < objc) { 599 if (Tcl_GetIndexFromObj(interp, objv[i++], envopen, "option", 600 TCL_EXACT, &optindex) != TCL_OK) { 601 Tcl_ResetResult(interp); 602 continue; 603 } 604#ifdef CONFIG_TEST 605 switch ((enum envopen)optindex) { 606 case TCL_ENV_SERVER: 607 if (i >= objc) { 608 Tcl_WrongNumArgs(interp, 2, objv, 609 "?-server hostname"); 610 result = TCL_ERROR; 611 break; 612 } 613 FLD_SET(cr_flags, DB_RPCCLIENT); 614 server = Tcl_GetStringFromObj(objv[i++], NULL); 615 break; 616 case TCL_ENV_SERVER_TO: 617 if (i >= objc) { 618 Tcl_WrongNumArgs(interp, 2, objv, 619 "?-server_to secs"); 620 result = TCL_ERROR; 621 break; 622 } 623 FLD_SET(cr_flags, DB_RPCCLIENT); 624 result = Tcl_GetLongFromObj(interp, objv[i++], 625 &server_to); 626 break; 627 case TCL_ENV_CLIENT_TO: 628 if (i >= objc) { 629 Tcl_WrongNumArgs(interp, 2, objv, 630 "?-client_to secs"); 631 result = TCL_ERROR; 632 break; 633 } 634 FLD_SET(cr_flags, DB_RPCCLIENT); 635 result = Tcl_GetLongFromObj(interp, objv[i++], 636 &client_to); 637 break; 638 default: 639 break; 640 } 641#endif 642 } 643 if (result != TCL_OK) 644 return (TCL_ERROR); 645 if ((ret = db_env_create(&dbenv, cr_flags)) != 0) 646 return (_ReturnSetup(interp, ret, DB_RETOK_STD(ret), 647 "db_env_create")); 648 *dbenvp = dbenv; 649 650 /* 651 * From here on we must 'goto error' in order to clean up the 652 * dbenv from db_env_create. 653 */ 654 dbenv->set_errpfx(dbenv, ip->i_name); 655 dbenv->set_errcall(dbenv, _ErrorFunc); 656 if (server != NULL && 657 (ret = dbenv->set_rpc_server(dbenv, NULL, server, 658 client_to, server_to, 0)) != 0) { 659 result = TCL_ERROR; 660 goto error; 661 } 662 663 /* Hang our info pointer on the dbenv handle, so we can do callbacks. */ 664 dbenv->app_private = ip; 665 666 /* 667 * Get the command name index from the object based on the bdbcmds 668 * defined above. 669 */ 670 i = 2; 671 while (i < objc) { 672 Tcl_ResetResult(interp); 673 if (Tcl_GetIndexFromObj(interp, objv[i], envopen, "option", 674 TCL_EXACT, &optindex) != TCL_OK) { 675 result = IS_HELP(objv[i]); 676 goto error; 677 } 678 i++; 679 switch ((enum envopen)optindex) { 680#ifdef CONFIG_TEST 681 case TCL_ENV_SERVER: 682 case TCL_ENV_SERVER_TO: 683 case TCL_ENV_CLIENT_TO: 684 /* 685 * Already handled these, skip them and their arg. 686 */ 687 i++; 688 break; 689 case TCL_ENV_ALLOC: 690 /* 691 * Use a Tcl-local alloc and free function so that 692 * we're sure to test whether we use umalloc/ufree in 693 * the right places. 694 */ 695 (void)dbenv->set_alloc(dbenv, 696 tcl_db_malloc, tcl_db_realloc, tcl_db_free); 697 break; 698 case TCL_ENV_AUTO_COMMIT: 699 FLD_SET(set_flags, DB_AUTO_COMMIT); 700 break; 701 case TCL_ENV_CDB: 702 FLD_SET(open_flags, DB_INIT_CDB | DB_INIT_MPOOL); 703 break; 704 case TCL_ENV_CDB_ALLDB: 705 FLD_SET(set_flags, DB_CDB_ALLDB); 706 break; 707 case TCL_ENV_LOCK: 708 FLD_SET(open_flags, DB_INIT_LOCK | DB_INIT_MPOOL); 709 break; 710 case TCL_ENV_CONFLICT: 711 /* 712 * Get conflict list. List is: 713 * {nmodes {matrix}} 714 * 715 * Where matrix must be nmodes*nmodes big. 716 * Set up conflicts array to pass. 717 */ 718 result = Tcl_ListObjGetElements(interp, objv[i], 719 &myobjc, &myobjv); 720 if (result == TCL_OK) 721 i++; 722 else 723 break; 724 if (myobjc != 2) { 725 Tcl_WrongNumArgs(interp, 2, objv, 726 "?-lock_conflict {nmodes {matrix}}?"); 727 result = TCL_ERROR; 728 break; 729 } 730 result = Tcl_GetIntFromObj(interp, myobjv[0], &nmodes); 731 if (result != TCL_OK) 732 break; 733 result = Tcl_ListObjGetElements(interp, myobjv[1], 734 &myobjc, &myobjv1); 735 if (myobjc != (nmodes * nmodes)) { 736 Tcl_WrongNumArgs(interp, 2, objv, 737 "?-lock_conflict {nmodes {matrix}}?"); 738 result = TCL_ERROR; 739 break; 740 } 741 742 ret = __os_malloc(dbenv->env, sizeof(u_int8_t) * 743 (size_t)nmodes * (size_t)nmodes, &conflicts); 744 if (ret != 0) { 745 result = TCL_ERROR; 746 break; 747 } 748 for (j = 0; j < myobjc; j++) { 749 result = Tcl_GetIntFromObj(interp, myobjv1[j], 750 &temp); 751 conflicts[j] = temp; 752 if (result != TCL_OK) { 753 __os_free(NULL, conflicts); 754 break; 755 } 756 } 757 _debug_check(); 758 ret = dbenv->set_lk_conflicts(dbenv, 759 (u_int8_t *)conflicts, nmodes); 760 __os_free(NULL, conflicts); 761 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 762 "set_lk_conflicts"); 763 break; 764 case TCL_ENV_DETECT: 765 if (i >= objc) { 766 Tcl_WrongNumArgs(interp, 2, objv, 767 "?-lock_detect policy?"); 768 result = TCL_ERROR; 769 break; 770 } 771 arg = Tcl_GetStringFromObj(objv[i++], NULL); 772 if (strcmp(arg, "default") == 0) 773 detect = DB_LOCK_DEFAULT; 774 else if (strcmp(arg, "expire") == 0) 775 detect = DB_LOCK_EXPIRE; 776 else if (strcmp(arg, "maxlocks") == 0) 777 detect = DB_LOCK_MAXLOCKS; 778 else if (strcmp(arg, "maxwrites") == 0) 779 detect = DB_LOCK_MAXWRITE; 780 else if (strcmp(arg, "minlocks") == 0) 781 detect = DB_LOCK_MINLOCKS; 782 else if (strcmp(arg, "minwrites") == 0) 783 detect = DB_LOCK_MINWRITE; 784 else if (strcmp(arg, "oldest") == 0) 785 detect = DB_LOCK_OLDEST; 786 else if (strcmp(arg, "youngest") == 0) 787 detect = DB_LOCK_YOUNGEST; 788 else if (strcmp(arg, "random") == 0) 789 detect = DB_LOCK_RANDOM; 790 else { 791 Tcl_AddErrorInfo(interp, 792 "lock_detect: illegal policy"); 793 result = TCL_ERROR; 794 break; 795 } 796 _debug_check(); 797 ret = dbenv->set_lk_detect(dbenv, detect); 798 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 799 "lock_detect"); 800 break; 801 case TCL_ENV_EVENT: 802 if (i >= objc) { 803 Tcl_WrongNumArgs(interp, 2, objv, 804 "-event eventproc"); 805 result = TCL_ERROR; 806 break; 807 } 808 result = tcl_EventNotify(interp, dbenv, objv[i++], ip); 809 break; 810 case TCL_ENV_LOCK_MAX_LOCKS: 811 case TCL_ENV_LOCK_MAX_LOCKERS: 812 case TCL_ENV_LOCK_MAX_OBJECTS: 813 case TCL_ENV_LOCK_PARTITIONS: 814 if (i >= objc) { 815 Tcl_WrongNumArgs(interp, 2, objv, 816 "?-lock_max max?"); 817 result = TCL_ERROR; 818 break; 819 } 820 result = _GetUInt32(interp, objv[i++], &uintarg); 821 if (result == TCL_OK) { 822 _debug_check(); 823 switch ((enum envopen)optindex) { 824 case TCL_ENV_LOCK_MAX_LOCKS: 825 ret = dbenv->set_lk_max_locks(dbenv, 826 uintarg); 827 break; 828 case TCL_ENV_LOCK_MAX_LOCKERS: 829 ret = dbenv->set_lk_max_lockers(dbenv, 830 uintarg); 831 break; 832 case TCL_ENV_LOCK_MAX_OBJECTS: 833 ret = dbenv->set_lk_max_objects(dbenv, 834 uintarg); 835 break; 836 case TCL_ENV_LOCK_PARTITIONS: 837 ret = dbenv->set_lk_partitions(dbenv, 838 uintarg); 839 break; 840 default: 841 break; 842 } 843 result = _ReturnSetup(interp, ret, 844 DB_RETOK_STD(ret), "lock_max"); 845 } 846 break; 847 case TCL_ENV_TXN_NOWAIT: 848 FLD_SET(set_flags, DB_TXN_NOWAIT); 849 break; 850 case TCL_ENV_TXN_TIME: 851 case TCL_ENV_TXN_TIMEOUT: 852 case TCL_ENV_LOCK_TIMEOUT: 853 if (i >= objc) { 854 Tcl_WrongNumArgs(interp, 2, objv, 855 "?-txn_timestamp time?"); 856 result = TCL_ERROR; 857 break; 858 } 859 860 if ((result = Tcl_GetLongFromObj( 861 interp, objv[i++], &v)) != TCL_OK) 862 break; 863 timestamp = (time_t)v; 864 865 _debug_check(); 866 if ((enum envopen)optindex == TCL_ENV_TXN_TIME) 867 ret = 868 dbenv->set_tx_timestamp(dbenv, ×tamp); 869 else 870 ret = dbenv->set_timeout(dbenv, 871 (db_timeout_t)timestamp, 872 (enum envopen)optindex == 873 TCL_ENV_TXN_TIMEOUT ? 874 DB_SET_TXN_TIMEOUT : DB_SET_LOCK_TIMEOUT); 875 result = _ReturnSetup(interp, ret, 876 DB_RETOK_STD(ret), "txn_timestamp"); 877 break; 878 case TCL_ENV_LOG: 879 FLD_SET(open_flags, DB_INIT_LOG | DB_INIT_MPOOL); 880 break; 881 case TCL_ENV_LOG_BUFFER: 882 if (i >= objc) { 883 Tcl_WrongNumArgs(interp, 2, objv, 884 "?-log_buffer size?"); 885 result = TCL_ERROR; 886 break; 887 } 888 result = _GetUInt32(interp, objv[i++], &uintarg); 889 if (result == TCL_OK) { 890 _debug_check(); 891 ret = dbenv->set_lg_bsize(dbenv, uintarg); 892 result = _ReturnSetup(interp, ret, 893 DB_RETOK_STD(ret), "log_bsize"); 894 logbufset = 1; 895 if (logmaxset) { 896 _debug_check(); 897 ret = dbenv->set_lg_max(dbenv, 898 logmaxset); 899 result = _ReturnSetup(interp, ret, 900 DB_RETOK_STD(ret), "log_max"); 901 logmaxset = 0; 902 logbufset = 0; 903 } 904 } 905 break; 906 case TCL_ENV_LOG_FILEMODE: 907 if (i >= objc) { 908 Tcl_WrongNumArgs(interp, 2, objv, 909 "?-log_filemode mode?"); 910 result = TCL_ERROR; 911 break; 912 } 913 result = _GetUInt32(interp, objv[i++], &uintarg); 914 if (result == TCL_OK) { 915 _debug_check(); 916 ret = dbenv->set_lg_filemode(dbenv, 917 (int)uintarg); 918 result = _ReturnSetup(interp, ret, 919 DB_RETOK_STD(ret), "log_filemode"); 920 } 921 break; 922 case TCL_ENV_LOG_INMEMORY: 923 ret = 924 dbenv->log_set_config(dbenv, DB_LOG_IN_MEMORY, 1); 925 result = _ReturnSetup(interp, ret, 926 DB_RETOK_STD(ret), "log_inmemory"); 927 break; 928 case TCL_ENV_LOG_MAX: 929 if (i >= objc) { 930 Tcl_WrongNumArgs(interp, 2, objv, 931 "?-log_max max?"); 932 result = TCL_ERROR; 933 break; 934 } 935 result = _GetUInt32(interp, objv[i++], &uintarg); 936 if (result == TCL_OK && logbufset) { 937 _debug_check(); 938 ret = dbenv->set_lg_max(dbenv, uintarg); 939 result = _ReturnSetup(interp, ret, 940 DB_RETOK_STD(ret), "log_max"); 941 logbufset = 0; 942 } else 943 logmaxset = uintarg; 944 break; 945 case TCL_ENV_LOG_REGIONMAX: 946 if (i >= objc) { 947 Tcl_WrongNumArgs(interp, 2, objv, 948 "?-log_regionmax size?"); 949 result = TCL_ERROR; 950 break; 951 } 952 result = _GetUInt32(interp, objv[i++], &uintarg); 953 if (result == TCL_OK) { 954 _debug_check(); 955 ret = dbenv->set_lg_regionmax(dbenv, uintarg); 956 result = 957 _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 958 "log_regionmax"); 959 } 960 break; 961 case TCL_ENV_LOG_REMOVE: 962 ret = 963 dbenv->log_set_config(dbenv, DB_LOG_AUTO_REMOVE, 1); 964 result = _ReturnSetup(interp, ret, 965 DB_RETOK_STD(ret), "log_remove"); 966 break; 967 case TCL_ENV_MPOOL_MAX_OPENFD: 968 if (i >= objc) { 969 Tcl_WrongNumArgs(interp, 2, objv, 970 "?-mpool_max_openfd fd_count?"); 971 result = TCL_ERROR; 972 break; 973 } 974 result = Tcl_GetIntFromObj(interp, objv[i++], &intarg); 975 if (result == TCL_OK) { 976 _debug_check(); 977 ret = dbenv->set_mp_max_openfd(dbenv, intarg); 978 result = _ReturnSetup(interp, ret, 979 DB_RETOK_STD(ret), "mpool_max_openfd"); 980 } 981 break; 982 case TCL_ENV_MPOOL_MAX_WRITE: 983 result = Tcl_ListObjGetElements(interp, objv[i], 984 &myobjc, &myobjv); 985 if (result == TCL_OK) 986 i++; 987 else 988 break; 989 if (myobjc != 2) { 990 Tcl_WrongNumArgs(interp, 2, objv, 991 "?-mpool_max_write {nwrite nsleep}?"); 992 result = TCL_ERROR; 993 break; 994 } 995 result = Tcl_GetIntFromObj(interp, myobjv[0], &intarg); 996 if (result != TCL_OK) 997 break; 998 result = Tcl_GetIntFromObj(interp, myobjv[1], &intarg2); 999 if (result != TCL_OK) 1000 break; 1001 _debug_check(); 1002 ret = dbenv->set_mp_max_write( 1003 dbenv, intarg, (db_timeout_t)intarg2); 1004 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 1005 "set_mp_max_write"); 1006 break; 1007 case TCL_ENV_MPOOL_MMAP_SIZE: 1008 if (i >= objc) { 1009 Tcl_WrongNumArgs(interp, 2, objv, 1010 "?-mpool_mmap_size size?"); 1011 result = TCL_ERROR; 1012 break; 1013 } 1014 result = Tcl_GetIntFromObj(interp, objv[i++], &intarg); 1015 if (result == TCL_OK) { 1016 _debug_check(); 1017 ret = dbenv->set_mp_mmapsize(dbenv, 1018 (size_t)intarg); 1019 result = _ReturnSetup(interp, ret, 1020 DB_RETOK_STD(ret), "mpool_mmap_size"); 1021 } 1022 break; 1023 case TCL_ENV_MPOOL_NOMMAP: 1024 FLD_SET(set_flags, DB_NOMMAP); 1025 break; 1026 case TCL_ENV_MULTIVERSION: 1027 FLD_SET(set_flags, DB_MULTIVERSION); 1028 break; 1029 case TCL_ENV_OVERWRITE: 1030 FLD_SET(set_flags, DB_OVERWRITE); 1031 break; 1032 case TCL_ENV_REGION_INIT: 1033 _debug_check(); 1034 ret = dbenv->set_flags(dbenv, DB_REGION_INIT, 1); 1035 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 1036 "region_init"); 1037 break; 1038 case TCL_ENV_SET_INTERMEDIATE_DIR: 1039 if (i >= objc) { 1040 Tcl_WrongNumArgs(interp, 2, objv, 1041 "?-set_intermediate_dir_mode mode?"); 1042 result = TCL_ERROR; 1043 break; 1044 } 1045 arg = Tcl_GetStringFromObj(objv[i++], NULL); 1046 _debug_check(); 1047 ret = dbenv->set_intermediate_dir_mode(dbenv, arg); 1048 result = _ReturnSetup(interp, ret, 1049 DB_RETOK_STD(ret), "set_intermediate_dir_mode"); 1050 break; 1051 case TCL_ENV_REP: 1052 FLD_SET(open_flags, DB_INIT_REP); 1053 break; 1054 case TCL_ENV_REP_CLIENT: 1055 rep_flags = DB_REP_CLIENT; 1056 FLD_SET(open_flags, DB_INIT_REP); 1057 break; 1058 case TCL_ENV_REP_MASTER: 1059 rep_flags = DB_REP_MASTER; 1060 FLD_SET(open_flags, DB_INIT_REP); 1061 break; 1062 case TCL_ENV_REP_LEASE: 1063 if (i >= objc) { 1064 Tcl_WrongNumArgs(interp, 2, objv, 1065 "-rep_lease {nsites timeout clockskew}"); 1066 result = TCL_ERROR; 1067 break; 1068 } 1069 result = Tcl_ListObjGetElements(interp, objv[i], 1070 &myobjc, &myobjv); 1071 if (result == TCL_OK) 1072 i++; 1073 else 1074 break; 1075 result = tcl_RepLease(interp, myobjc, myobjv, dbenv); 1076 if (result == TCL_OK) 1077 FLD_SET(open_flags, DB_INIT_REP); 1078 break; 1079 case TCL_ENV_REP_TRANSPORT: 1080 if (i >= objc) { 1081 Tcl_WrongNumArgs(interp, 2, objv, 1082 "-rep_transport {envid sendproc}"); 1083 result = TCL_ERROR; 1084 break; 1085 } 1086 result = Tcl_ListObjGetElements(interp, objv[i], 1087 &myobjc, &myobjv); 1088 if (result == TCL_OK) 1089 i++; 1090 else 1091 break; 1092 result = tcl_RepTransport( 1093 interp, myobjc, myobjv, dbenv, ip); 1094 if (result == TCL_OK) 1095 FLD_SET(open_flags, DB_INIT_REP); 1096 break; 1097 case TCL_ENV_SNAPSHOT: 1098 FLD_SET(set_flags, DB_TXN_SNAPSHOT); 1099 break; 1100 case TCL_ENV_THREAD: 1101 /* Enable DB_THREAD when specified in testing. */ 1102 FLD_SET(open_flags, DB_THREAD); 1103 break; 1104 case TCL_ENV_TIME_NOTGRANTED: 1105 FLD_SET(set_flags, DB_TIME_NOTGRANTED); 1106 break; 1107 case TCL_ENV_VERBOSE: 1108 result = Tcl_ListObjGetElements(interp, objv[i], 1109 &myobjc, &myobjv); 1110 if (result == TCL_OK) 1111 i++; 1112 else 1113 break; 1114 if (myobjc != 2) { 1115 Tcl_WrongNumArgs(interp, 2, objv, 1116 "?-verbose {which on|off}?"); 1117 result = TCL_ERROR; 1118 break; 1119 } 1120 result = tcl_EnvVerbose( 1121 interp, dbenv, myobjv[0], myobjv[1]); 1122 break; 1123 case TCL_ENV_WRNOSYNC: 1124 FLD_SET(set_flags, DB_TXN_WRITE_NOSYNC); 1125 break; 1126 case TCL_ENV_ZEROLOG: 1127 if ((ret = 1128 dbenv->log_set_config(dbenv, DB_LOG_ZERO, 1)) != 0) 1129 return ( 1130 _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 1131 "set_log_config")); 1132 break; 1133#endif 1134 case TCL_ENV_TXN: 1135 FLD_SET(open_flags, DB_INIT_LOCK | 1136 DB_INIT_LOG | DB_INIT_MPOOL | DB_INIT_TXN); 1137 /* Make sure we have an arg to check against! */ 1138 while (i < objc) { 1139 arg = Tcl_GetStringFromObj(objv[i], NULL); 1140 if (strcmp(arg, "nosync") == 0) { 1141 FLD_SET(set_flags, DB_TXN_NOSYNC); 1142 i++; 1143 } else if (strcmp(arg, "snapshot") == 0) { 1144 FLD_SET(set_flags, DB_TXN_SNAPSHOT); 1145 i++; 1146 } else 1147 break; 1148 } 1149 break; 1150 case TCL_ENV_CREATE: 1151 FLD_SET(open_flags, DB_CREATE | DB_INIT_MPOOL); 1152 break; 1153 case TCL_ENV_ENCRYPT_AES: 1154 /* Make sure we have an arg to check against! */ 1155 if (i >= objc) { 1156 Tcl_WrongNumArgs(interp, 2, objv, 1157 "?-encryptaes passwd?"); 1158 result = TCL_ERROR; 1159 break; 1160 } 1161 passwd = Tcl_GetStringFromObj(objv[i++], NULL); 1162 _debug_check(); 1163 ret = dbenv->set_encrypt(dbenv, passwd, DB_ENCRYPT_AES); 1164 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 1165 "set_encrypt"); 1166 break; 1167 case TCL_ENV_ENCRYPT_ANY: 1168 /* Make sure we have an arg to check against! */ 1169 if (i >= objc) { 1170 Tcl_WrongNumArgs(interp, 2, objv, 1171 "?-encryptany passwd?"); 1172 result = TCL_ERROR; 1173 break; 1174 } 1175 passwd = Tcl_GetStringFromObj(objv[i++], NULL); 1176 _debug_check(); 1177 ret = dbenv->set_encrypt(dbenv, passwd, 0); 1178 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 1179 "set_encrypt"); 1180 break; 1181 case TCL_ENV_HOME: 1182 /* Make sure we have an arg to check against! */ 1183 if (i >= objc) { 1184 Tcl_WrongNumArgs(interp, 2, objv, 1185 "?-home dir?"); 1186 result = TCL_ERROR; 1187 break; 1188 } 1189 home = Tcl_GetStringFromObj(objv[i++], NULL); 1190 break; 1191 case TCL_ENV_MODE: 1192 if (i >= objc) { 1193 Tcl_WrongNumArgs(interp, 2, objv, 1194 "?-mode mode?"); 1195 result = TCL_ERROR; 1196 break; 1197 } 1198 /* 1199 * Don't need to check result here because 1200 * if TCL_ERROR, the error message is already 1201 * set up, and we'll bail out below. If ok, 1202 * the mode is set and we go on. 1203 */ 1204 result = Tcl_GetIntFromObj(interp, objv[i++], &mode); 1205 break; 1206 case TCL_ENV_PRIVATE: 1207 FLD_SET(open_flags, DB_PRIVATE | DB_INIT_MPOOL); 1208 break; 1209 case TCL_ENV_RECOVER: 1210 FLD_SET(open_flags, DB_RECOVER); 1211 break; 1212 case TCL_ENV_RECOVER_FATAL: 1213 FLD_SET(open_flags, DB_RECOVER_FATAL); 1214 break; 1215 case TCL_ENV_REGISTER: 1216 FLD_SET(open_flags, DB_REGISTER); 1217 break; 1218 case TCL_ENV_SYSTEM_MEM: 1219 FLD_SET(open_flags, DB_SYSTEM_MEM); 1220 break; 1221 case TCL_ENV_USE_ENVIRON_ROOT: 1222 FLD_SET(open_flags, DB_USE_ENVIRON_ROOT); 1223 break; 1224 case TCL_ENV_USE_ENVIRON: 1225 FLD_SET(open_flags, DB_USE_ENVIRON); 1226 break; 1227 case TCL_ENV_CACHESIZE: 1228 result = Tcl_ListObjGetElements(interp, objv[i], 1229 &myobjc, &myobjv); 1230 if (result == TCL_OK) 1231 i++; 1232 else 1233 break; 1234 if (myobjc != 3) { 1235 Tcl_WrongNumArgs(interp, 2, objv, 1236 "?-cachesize {gbytes bytes ncaches}?"); 1237 result = TCL_ERROR; 1238 break; 1239 } 1240 result = _GetUInt32(interp, myobjv[0], &gbytes); 1241 if (result != TCL_OK) 1242 break; 1243 result = _GetUInt32(interp, myobjv[1], &bytes); 1244 if (result != TCL_OK) 1245 break; 1246 result = Tcl_GetIntFromObj(interp, myobjv[2], &ncaches); 1247 if (result != TCL_OK) 1248 break; 1249 _debug_check(); 1250 ret = dbenv->set_cachesize(dbenv, gbytes, bytes, 1251 ncaches); 1252 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 1253 "set_cachesize"); 1254 break; 1255 case TCL_ENV_CACHE_MAX: 1256 result = Tcl_ListObjGetElements(interp, objv[i], 1257 &myobjc, &myobjv); 1258 if (result == TCL_OK) 1259 i++; 1260 else 1261 break; 1262 if (myobjc != 2) { 1263 Tcl_WrongNumArgs(interp, 2, objv, 1264 "?-cache_max {gbytes bytes}?"); 1265 result = TCL_ERROR; 1266 break; 1267 } 1268 result = _GetUInt32(interp, myobjv[0], &gbytes); 1269 if (result != TCL_OK) 1270 break; 1271 result = _GetUInt32(interp, myobjv[1], &bytes); 1272 if (result != TCL_OK) 1273 break; 1274 _debug_check(); 1275 ret = dbenv->set_cache_max(dbenv, gbytes, bytes); 1276 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 1277 "set_cache_max"); 1278 break; 1279 case TCL_ENV_SHM_KEY: 1280 if (i >= objc) { 1281 Tcl_WrongNumArgs(interp, 2, objv, 1282 "?-shm_key key?"); 1283 result = TCL_ERROR; 1284 break; 1285 } 1286 result = Tcl_GetLongFromObj(interp, objv[i++], &shm); 1287 if (result == TCL_OK) { 1288 _debug_check(); 1289 ret = dbenv->set_shm_key(dbenv, shm); 1290 result = _ReturnSetup(interp, ret, 1291 DB_RETOK_STD(ret), "shm_key"); 1292 } 1293 break; 1294 case TCL_ENV_TXN_MAX: 1295 if (i >= objc) { 1296 Tcl_WrongNumArgs(interp, 2, objv, 1297 "?-txn_max max?"); 1298 result = TCL_ERROR; 1299 break; 1300 } 1301 result = _GetUInt32(interp, objv[i++], &uintarg); 1302 if (result == TCL_OK) { 1303 _debug_check(); 1304 ret = dbenv->set_tx_max(dbenv, uintarg); 1305 result = _ReturnSetup(interp, ret, 1306 DB_RETOK_STD(ret), "txn_max"); 1307 } 1308 break; 1309 case TCL_ENV_ERRFILE: 1310 if (i >= objc) { 1311 Tcl_WrongNumArgs(interp, 2, objv, 1312 "-errfile file"); 1313 result = TCL_ERROR; 1314 break; 1315 } 1316 arg = Tcl_GetStringFromObj(objv[i++], NULL); 1317 tcl_EnvSetErrfile(interp, dbenv, ip, arg); 1318 break; 1319 case TCL_ENV_ERRPFX: 1320 if (i >= objc) { 1321 Tcl_WrongNumArgs(interp, 2, objv, 1322 "-errpfx prefix"); 1323 result = TCL_ERROR; 1324 break; 1325 } 1326 arg = Tcl_GetStringFromObj(objv[i++], NULL); 1327 _debug_check(); 1328 result = tcl_EnvSetErrpfx(interp, dbenv, ip, arg); 1329 break; 1330 case TCL_ENV_DATA_DIR: 1331 if (i >= objc) { 1332 Tcl_WrongNumArgs(interp, 2, objv, 1333 "-data_dir dir"); 1334 result = TCL_ERROR; 1335 break; 1336 } 1337 arg = Tcl_GetStringFromObj(objv[i++], NULL); 1338 _debug_check(); 1339 ret = dbenv->set_data_dir(dbenv, arg); 1340 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 1341 "set_data_dir"); 1342 break; 1343 case TCL_ENV_LOG_DIR: 1344 if (i >= objc) { 1345 Tcl_WrongNumArgs(interp, 2, objv, 1346 "-log_dir dir"); 1347 result = TCL_ERROR; 1348 break; 1349 } 1350 arg = Tcl_GetStringFromObj(objv[i++], NULL); 1351 _debug_check(); 1352 ret = dbenv->set_lg_dir(dbenv, arg); 1353 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 1354 "set_lg_dir"); 1355 break; 1356 case TCL_ENV_TMP_DIR: 1357 if (i >= objc) { 1358 Tcl_WrongNumArgs(interp, 2, objv, 1359 "-tmp_dir dir"); 1360 result = TCL_ERROR; 1361 break; 1362 } 1363 arg = Tcl_GetStringFromObj(objv[i++], NULL); 1364 _debug_check(); 1365 ret = dbenv->set_tmp_dir(dbenv, arg); 1366 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 1367 "set_tmp_dir"); 1368 break; 1369 } 1370 /* 1371 * If, at any time, parsing the args we get an error, 1372 * bail out and return. 1373 */ 1374 if (result != TCL_OK) 1375 goto error; 1376 } 1377 1378 /* 1379 * We have to check this here. We want to set the log buffer 1380 * size first, if it is specified. So if the user did so, 1381 * then we took care of it above. But, if we get out here and 1382 * logmaxset is non-zero, then they set the log_max without 1383 * resetting the log buffer size, so we now have to do the 1384 * call to set_lg_max, since we didn't do it above. 1385 */ 1386 if (logmaxset) { 1387 _debug_check(); 1388 ret = dbenv->set_lg_max(dbenv, (u_int32_t)logmaxset); 1389 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 1390 "log_max"); 1391 } 1392 1393 if (result != TCL_OK) 1394 goto error; 1395 1396 if (set_flags) { 1397 ret = dbenv->set_flags(dbenv, set_flags, 1); 1398 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 1399 "set_flags"); 1400 if (result == TCL_ERROR) 1401 goto error; 1402 /* 1403 * If we are successful, clear the result so that the 1404 * return from set_flags isn't part of the result. 1405 */ 1406 Tcl_ResetResult(interp); 1407 } 1408 /* 1409 * When we get here, we have already parsed all of our args 1410 * and made all our calls to set up the environment. Everything 1411 * is okay so far, no errors, if we get here. 1412 * 1413 * Now open the environment. 1414 */ 1415 _debug_check(); 1416 ret = dbenv->open(dbenv, home, open_flags, mode); 1417 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "dbenv open"); 1418 1419 if (rep_flags != 0 && result == TCL_OK) { 1420 _debug_check(); 1421 ret = dbenv->rep_start(dbenv, NULL, rep_flags); 1422 result = _ReturnSetup(interp, 1423 ret, DB_RETOK_STD(ret), "rep_start"); 1424 } 1425 1426error: if (result == TCL_ERROR) { 1427 if (ip->i_err && ip->i_err != stdout && ip->i_err != stderr) { 1428 (void)fclose(ip->i_err); 1429 ip->i_err = NULL; 1430 } 1431 (void)dbenv->close(dbenv, 0); 1432 } 1433 return (result); 1434} 1435 1436/* 1437 * bdb_DbOpen -- 1438 * Implements the "db_create/db_open" command. 1439 * There are many, many options to the open command. 1440 * Here is the general flow: 1441 * 1442 * 0. Preparse args to determine if we have -env. 1443 * 1. Call db_create to create the db handle. 1444 * 2. Parse args tracking options. 1445 * 3. Make any pre-open setup calls necessary. 1446 * 4. Call DB->open to open the database. 1447 * 5. Return db widget handle to user. 1448 */ 1449static int 1450bdb_DbOpen(interp, objc, objv, ip, dbp) 1451 Tcl_Interp *interp; /* Interpreter */ 1452 int objc; /* How many arguments? */ 1453 Tcl_Obj *CONST objv[]; /* The argument objects */ 1454 DBTCL_INFO *ip; /* Our internal info */ 1455 DB **dbp; /* DB handle */ 1456{ 1457 static const char *bdbenvopen[] = { 1458 "-env", NULL 1459 }; 1460 enum bdbenvopen { 1461 TCL_DB_ENV0 1462 }; 1463 static const char *bdbopen[] = { 1464#ifdef CONFIG_TEST 1465 "-btcompare", 1466 "-dupcompare", 1467 "-hashcompare", 1468 "-hashproc", 1469 "-lorder", 1470 "-minkey", 1471 "-nommap", 1472 "-notdurable", 1473 "-read_uncommitted", 1474 "-revsplitoff", 1475 "-test", 1476 "-thread", 1477#endif 1478 "-auto_commit", 1479 "-btree", 1480 "-cachesize", 1481 "-chksum", 1482 "-create", 1483 "-delim", 1484 "-dup", 1485 "-dupsort", 1486 "-encrypt", 1487 "-encryptaes", 1488 "-encryptany", 1489 "-env", 1490 "-errfile", 1491 "-errpfx", 1492 "-excl", 1493 "-extent", 1494 "-ffactor", 1495 "-hash", 1496 "-inorder", 1497 "-len", 1498 "-maxsize", 1499 "-mode", 1500 "-multiversion", 1501 "-nelem", 1502 "-pad", 1503 "-pagesize", 1504 "-queue", 1505 "-rdonly", 1506 "-recno", 1507 "-recnum", 1508 "-renumber", 1509 "-snapshot", 1510 "-source", 1511 "-truncate", 1512 "-txn", 1513 "-unknown", 1514 "--", 1515 NULL 1516 }; 1517 enum bdbopen { 1518#ifdef CONFIG_TEST 1519 TCL_DB_BTCOMPARE, 1520 TCL_DB_DUPCOMPARE, 1521 TCL_DB_HASHCOMPARE, 1522 TCL_DB_HASHPROC, 1523 TCL_DB_LORDER, 1524 TCL_DB_MINKEY, 1525 TCL_DB_NOMMAP, 1526 TCL_DB_NOTDURABLE, 1527 TCL_DB_READ_UNCOMMITTED, 1528 TCL_DB_REVSPLIT, 1529 TCL_DB_TEST, 1530 TCL_DB_THREAD, 1531#endif 1532 TCL_DB_AUTO_COMMIT, 1533 TCL_DB_BTREE, 1534 TCL_DB_CACHESIZE, 1535 TCL_DB_CHKSUM, 1536 TCL_DB_CREATE, 1537 TCL_DB_DELIM, 1538 TCL_DB_DUP, 1539 TCL_DB_DUPSORT, 1540 TCL_DB_ENCRYPT, 1541 TCL_DB_ENCRYPT_AES, 1542 TCL_DB_ENCRYPT_ANY, 1543 TCL_DB_ENV, 1544 TCL_DB_ERRFILE, 1545 TCL_DB_ERRPFX, 1546 TCL_DB_EXCL, 1547 TCL_DB_EXTENT, 1548 TCL_DB_FFACTOR, 1549 TCL_DB_HASH, 1550 TCL_DB_INORDER, 1551 TCL_DB_LEN, 1552 TCL_DB_MAXSIZE, 1553 TCL_DB_MODE, 1554 TCL_DB_MULTIVERSION, 1555 TCL_DB_NELEM, 1556 TCL_DB_PAD, 1557 TCL_DB_PAGESIZE, 1558 TCL_DB_QUEUE, 1559 TCL_DB_RDONLY, 1560 TCL_DB_RECNO, 1561 TCL_DB_RECNUM, 1562 TCL_DB_RENUMBER, 1563 TCL_DB_SNAPSHOT, 1564 TCL_DB_SOURCE, 1565 TCL_DB_TRUNCATE, 1566 TCL_DB_TXN, 1567 TCL_DB_UNKNOWN, 1568 TCL_DB_ENDARG 1569 }; 1570 DBTCL_INFO *envip, *errip; 1571 DBTYPE type; 1572 DB_ENV *dbenv; 1573 DB_TXN *txn; 1574 ENV *env; 1575 1576 Tcl_Obj **myobjv; 1577 u_int32_t gbytes, bytes, open_flags, set_flags, uintarg; 1578 int endarg, i, intarg, mode, myobjc, ncaches; 1579 int optindex, result, ret, set_err, set_pfx, subdblen; 1580 u_char *subdbtmp; 1581 char *arg, *db, *passwd, *subdb, msg[MSG_SIZE]; 1582 1583 type = DB_UNKNOWN; 1584 endarg = mode = set_err = set_flags = set_pfx = 0; 1585 result = TCL_OK; 1586 subdbtmp = NULL; 1587 db = subdb = NULL; 1588 1589 /* 1590 * XXX 1591 * If/when our Tcl interface becomes thread-safe, we should enable 1592 * DB_THREAD here in all cases. For now, we turn it on later in this 1593 * function, and only when we're in testing and we specify the 1594 * -thread flag, so that we can exercise MUTEX_THREAD_LOCK cases. 1595 * 1596 * In order to become truly thread-safe, we need to look at making sure 1597 * DBTCL_INFO structs are safe to share across threads (they're not 1598 * mutex-protected) before we declare the Tcl interface thread-safe. 1599 * Meanwhile, there's no strong reason to enable DB_THREAD when not 1600 * testing. 1601 */ 1602 open_flags = 0; 1603 1604 dbenv = NULL; 1605 txn = NULL; 1606 env = NULL; 1607 1608 if (objc < 2) { 1609 Tcl_WrongNumArgs(interp, 2, objv, "?args?"); 1610 return (TCL_ERROR); 1611 } 1612 1613 /* 1614 * We must first parse for the environment flag, since that 1615 * is needed for db_create. Then create the db handle. 1616 */ 1617 i = 2; 1618 while (i < objc) { 1619 if (Tcl_GetIndexFromObj(interp, objv[i++], bdbenvopen, 1620 "option", TCL_EXACT, &optindex) != TCL_OK) { 1621 /* 1622 * Reset the result so we don't get 1623 * an errant error message if there is another error. 1624 */ 1625 Tcl_ResetResult(interp); 1626 continue; 1627 } 1628 switch ((enum bdbenvopen)optindex) { 1629 case TCL_DB_ENV0: 1630 arg = Tcl_GetStringFromObj(objv[i], NULL); 1631 dbenv = NAME_TO_ENV(arg); 1632 if (dbenv == NULL) { 1633 Tcl_SetResult(interp, 1634 "db open: illegal environment", TCL_STATIC); 1635 return (TCL_ERROR); 1636 } 1637 } 1638 break; 1639 } 1640 1641 /* 1642 * Create the db handle before parsing the args 1643 * since we'll be modifying the database options as we parse. 1644 */ 1645 ret = db_create(dbp, dbenv, 0); 1646 if (ret) 1647 return (_ReturnSetup(interp, ret, DB_RETOK_STD(ret), 1648 "db_create")); 1649 1650 /* Hang our info pointer on the DB handle, so we can do callbacks. */ 1651 (*dbp)->api_internal = ip; 1652 1653 /* 1654 * XXX 1655 * Remove restriction if error handling not tied to env. 1656 * 1657 * The DB->set_err* functions overwrite the environment. So, if 1658 * we are using an env, don't overwrite it; if not using an env, 1659 * then configure error handling. 1660 */ 1661 if (dbenv == NULL) { 1662 env = NULL; 1663 (*dbp)->set_errpfx((*dbp), ip->i_name); 1664 (*dbp)->set_errcall((*dbp), _ErrorFunc); 1665 } else 1666 env = dbenv->env; 1667 1668 /* 1669 * If we are using an env, we keep track of err info in the env's ip. 1670 * Otherwise use the DB's ip. 1671 */ 1672 envip = _PtrToInfo(dbenv); /* XXX */ 1673 if (envip) 1674 errip = envip; 1675 else 1676 errip = ip; 1677 1678 /* 1679 * Get the option name index from the object based on the args 1680 * defined above. 1681 */ 1682 i = 2; 1683 while (i < objc) { 1684 Tcl_ResetResult(interp); 1685 if (Tcl_GetIndexFromObj(interp, objv[i], bdbopen, "option", 1686 TCL_EXACT, &optindex) != TCL_OK) { 1687 arg = Tcl_GetStringFromObj(objv[i], NULL); 1688 if (arg[0] == '-') { 1689 result = IS_HELP(objv[i]); 1690 goto error; 1691 } else 1692 Tcl_ResetResult(interp); 1693 break; 1694 } 1695 i++; 1696 switch ((enum bdbopen)optindex) { 1697#ifdef CONFIG_TEST 1698 case TCL_DB_BTCOMPARE: 1699 if (i >= objc) { 1700 Tcl_WrongNumArgs(interp, 2, objv, 1701 "-btcompare compareproc"); 1702 result = TCL_ERROR; 1703 break; 1704 } 1705 1706 /* 1707 * Store the object containing the procedure name. 1708 * We don't need to crack it out now--we'll want 1709 * to bundle it up to pass into Tcl_EvalObjv anyway. 1710 * Tcl's object refcounting will--I hope--take care 1711 * of the memory management here. 1712 */ 1713 ip->i_compare = objv[i++]; 1714 Tcl_IncrRefCount(ip->i_compare); 1715 _debug_check(); 1716 ret = (*dbp)->set_bt_compare(*dbp, tcl_bt_compare); 1717 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 1718 "set_bt_compare"); 1719 break; 1720 case TCL_DB_DUPCOMPARE: 1721 if (i >= objc) { 1722 Tcl_WrongNumArgs(interp, 2, objv, 1723 "-dupcompare compareproc"); 1724 result = TCL_ERROR; 1725 break; 1726 } 1727 1728 /* 1729 * Store the object containing the procedure name. 1730 * See TCL_DB_BTCOMPARE. 1731 */ 1732 ip->i_dupcompare = objv[i++]; 1733 Tcl_IncrRefCount(ip->i_dupcompare); 1734 _debug_check(); 1735 ret = (*dbp)->set_dup_compare(*dbp, tcl_dup_compare); 1736 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 1737 "set_dup_compare"); 1738 break; 1739 case TCL_DB_HASHCOMPARE: 1740 if (i >= objc) { 1741 Tcl_WrongNumArgs(interp, 2, objv, 1742 "-hashcompare compareproc"); 1743 result = TCL_ERROR; 1744 break; 1745 } 1746 1747 /* 1748 * Store the object containing the procedure name. 1749 * We don't need to crack it out now--we'll want 1750 * to bundle it up to pass into Tcl_EvalObjv anyway. 1751 * Tcl's object refcounting will--I hope--take care 1752 * of the memory management here. 1753 */ 1754 ip->i_compare = objv[i++]; 1755 Tcl_IncrRefCount(ip->i_compare); 1756 _debug_check(); 1757 ret = (*dbp)->set_h_compare(*dbp, tcl_bt_compare); 1758 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 1759 "set_h_compare"); 1760 break; 1761 case TCL_DB_HASHPROC: 1762 if (i >= objc) { 1763 Tcl_WrongNumArgs(interp, 2, objv, 1764 "-hashproc hashproc"); 1765 result = TCL_ERROR; 1766 break; 1767 } 1768 1769 /* 1770 * Store the object containing the procedure name. 1771 * See TCL_DB_BTCOMPARE. 1772 */ 1773 ip->i_hashproc = objv[i++]; 1774 Tcl_IncrRefCount(ip->i_hashproc); 1775 _debug_check(); 1776 ret = (*dbp)->set_h_hash(*dbp, tcl_h_hash); 1777 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 1778 "set_h_hash"); 1779 break; 1780 case TCL_DB_LORDER: 1781 if (i >= objc) { 1782 Tcl_WrongNumArgs(interp, 2, objv, 1783 "-lorder 1234|4321"); 1784 result = TCL_ERROR; 1785 break; 1786 } 1787 result = Tcl_GetIntFromObj(interp, objv[i++], &intarg); 1788 if (result == TCL_OK) { 1789 _debug_check(); 1790 ret = (*dbp)->set_lorder(*dbp, intarg); 1791 result = _ReturnSetup(interp, ret, 1792 DB_RETOK_STD(ret), "set_lorder"); 1793 } 1794 break; 1795 case TCL_DB_MINKEY: 1796 if (i >= objc) { 1797 Tcl_WrongNumArgs(interp, 2, objv, 1798 "-minkey minkey"); 1799 result = TCL_ERROR; 1800 break; 1801 } 1802 result = _GetUInt32(interp, objv[i++], &uintarg); 1803 if (result == TCL_OK) { 1804 _debug_check(); 1805 ret = (*dbp)->set_bt_minkey(*dbp, uintarg); 1806 result = _ReturnSetup(interp, ret, 1807 DB_RETOK_STD(ret), "set_bt_minkey"); 1808 } 1809 break; 1810 case TCL_DB_NOMMAP: 1811 open_flags |= DB_NOMMAP; 1812 break; 1813 case TCL_DB_NOTDURABLE: 1814 set_flags |= DB_TXN_NOT_DURABLE; 1815 break; 1816 case TCL_DB_READ_UNCOMMITTED: 1817 open_flags |= DB_READ_UNCOMMITTED; 1818 break; 1819 case TCL_DB_REVSPLIT: 1820 set_flags |= DB_REVSPLITOFF; 1821 break; 1822 case TCL_DB_TEST: 1823 ret = (*dbp)->set_h_hash(*dbp, __ham_test); 1824 result = _ReturnSetup(interp, ret, 1825 DB_RETOK_STD(ret), "set_h_hash"); 1826 break; 1827 case TCL_DB_THREAD: 1828 /* Enable DB_THREAD when specified in testing. */ 1829 open_flags |= DB_THREAD; 1830 break; 1831#endif 1832 case TCL_DB_AUTO_COMMIT: 1833 open_flags |= DB_AUTO_COMMIT; 1834 break; 1835 case TCL_DB_ENV: 1836 /* 1837 * Already parsed this, skip it and the env pointer. 1838 */ 1839 i++; 1840 continue; 1841 case TCL_DB_TXN: 1842 if (i > (objc - 1)) { 1843 Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?"); 1844 result = TCL_ERROR; 1845 break; 1846 } 1847 arg = Tcl_GetStringFromObj(objv[i++], NULL); 1848 txn = NAME_TO_TXN(arg); 1849 if (txn == NULL) { 1850 snprintf(msg, MSG_SIZE, 1851 "Open: Invalid txn: %s\n", arg); 1852 Tcl_SetResult(interp, msg, TCL_VOLATILE); 1853 result = TCL_ERROR; 1854 } 1855 break; 1856 case TCL_DB_BTREE: 1857 if (type != DB_UNKNOWN) { 1858 Tcl_SetResult(interp, 1859 "Too many DB types specified", TCL_STATIC); 1860 result = TCL_ERROR; 1861 goto error; 1862 } 1863 type = DB_BTREE; 1864 break; 1865 case TCL_DB_HASH: 1866 if (type != DB_UNKNOWN) { 1867 Tcl_SetResult(interp, 1868 "Too many DB types specified", TCL_STATIC); 1869 result = TCL_ERROR; 1870 goto error; 1871 } 1872 type = DB_HASH; 1873 break; 1874 case TCL_DB_RECNO: 1875 if (type != DB_UNKNOWN) { 1876 Tcl_SetResult(interp, 1877 "Too many DB types specified", TCL_STATIC); 1878 result = TCL_ERROR; 1879 goto error; 1880 } 1881 type = DB_RECNO; 1882 break; 1883 case TCL_DB_QUEUE: 1884 if (type != DB_UNKNOWN) { 1885 Tcl_SetResult(interp, 1886 "Too many DB types specified", TCL_STATIC); 1887 result = TCL_ERROR; 1888 goto error; 1889 } 1890 type = DB_QUEUE; 1891 break; 1892 case TCL_DB_UNKNOWN: 1893 if (type != DB_UNKNOWN) { 1894 Tcl_SetResult(interp, 1895 "Too many DB types specified", TCL_STATIC); 1896 result = TCL_ERROR; 1897 goto error; 1898 } 1899 break; 1900 case TCL_DB_CREATE: 1901 open_flags |= DB_CREATE; 1902 break; 1903 case TCL_DB_EXCL: 1904 open_flags |= DB_EXCL; 1905 break; 1906 case TCL_DB_RDONLY: 1907 open_flags |= DB_RDONLY; 1908 break; 1909 case TCL_DB_TRUNCATE: 1910 open_flags |= DB_TRUNCATE; 1911 break; 1912 case TCL_DB_MODE: 1913 if (i >= objc) { 1914 Tcl_WrongNumArgs(interp, 2, objv, 1915 "?-mode mode?"); 1916 result = TCL_ERROR; 1917 break; 1918 } 1919 /* 1920 * Don't need to check result here because 1921 * if TCL_ERROR, the error message is already 1922 * set up, and we'll bail out below. If ok, 1923 * the mode is set and we go on. 1924 */ 1925 result = Tcl_GetIntFromObj(interp, objv[i++], &mode); 1926 break; 1927 case TCL_DB_DUP: 1928 set_flags |= DB_DUP; 1929 break; 1930 case TCL_DB_DUPSORT: 1931 set_flags |= DB_DUPSORT; 1932 break; 1933 case TCL_DB_INORDER: 1934 set_flags |= DB_INORDER; 1935 break; 1936 case TCL_DB_RECNUM: 1937 set_flags |= DB_RECNUM; 1938 break; 1939 case TCL_DB_RENUMBER: 1940 set_flags |= DB_RENUMBER; 1941 break; 1942 case TCL_DB_SNAPSHOT: 1943 set_flags |= DB_SNAPSHOT; 1944 break; 1945 case TCL_DB_CHKSUM: 1946 set_flags |= DB_CHKSUM; 1947 break; 1948 case TCL_DB_ENCRYPT: 1949 set_flags |= DB_ENCRYPT; 1950 break; 1951 case TCL_DB_ENCRYPT_AES: 1952 /* Make sure we have an arg to check against! */ 1953 if (i >= objc) { 1954 Tcl_WrongNumArgs(interp, 2, objv, 1955 "?-encryptaes passwd?"); 1956 result = TCL_ERROR; 1957 break; 1958 } 1959 passwd = Tcl_GetStringFromObj(objv[i++], NULL); 1960 _debug_check(); 1961 ret = (*dbp)->set_encrypt(*dbp, passwd, DB_ENCRYPT_AES); 1962 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 1963 "set_encrypt"); 1964 break; 1965 case TCL_DB_ENCRYPT_ANY: 1966 /* Make sure we have an arg to check against! */ 1967 if (i >= objc) { 1968 Tcl_WrongNumArgs(interp, 2, objv, 1969 "?-encryptany passwd?"); 1970 result = TCL_ERROR; 1971 break; 1972 } 1973 passwd = Tcl_GetStringFromObj(objv[i++], NULL); 1974 _debug_check(); 1975 ret = (*dbp)->set_encrypt(*dbp, passwd, 0); 1976 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 1977 "set_encrypt"); 1978 break; 1979 case TCL_DB_FFACTOR: 1980 if (i >= objc) { 1981 Tcl_WrongNumArgs(interp, 2, objv, 1982 "-ffactor density"); 1983 result = TCL_ERROR; 1984 break; 1985 } 1986 result = _GetUInt32(interp, objv[i++], &uintarg); 1987 if (result == TCL_OK) { 1988 _debug_check(); 1989 ret = (*dbp)->set_h_ffactor(*dbp, uintarg); 1990 result = _ReturnSetup(interp, ret, 1991 DB_RETOK_STD(ret), "set_h_ffactor"); 1992 } 1993 break; 1994 case TCL_DB_MULTIVERSION: 1995 open_flags |= DB_MULTIVERSION; 1996 break; 1997 case TCL_DB_NELEM: 1998 if (i >= objc) { 1999 Tcl_WrongNumArgs(interp, 2, objv, 2000 "-nelem nelem"); 2001 result = TCL_ERROR; 2002 break; 2003 } 2004 result = _GetUInt32(interp, objv[i++], &uintarg); 2005 if (result == TCL_OK) { 2006 _debug_check(); 2007 ret = (*dbp)->set_h_nelem(*dbp, uintarg); 2008 result = _ReturnSetup(interp, ret, 2009 DB_RETOK_STD(ret), "set_h_nelem"); 2010 } 2011 break; 2012 case TCL_DB_DELIM: 2013 if (i >= objc) { 2014 Tcl_WrongNumArgs(interp, 2, objv, 2015 "-delim delim"); 2016 result = TCL_ERROR; 2017 break; 2018 } 2019 result = Tcl_GetIntFromObj(interp, objv[i++], &intarg); 2020 if (result == TCL_OK) { 2021 _debug_check(); 2022 ret = (*dbp)->set_re_delim(*dbp, intarg); 2023 result = _ReturnSetup(interp, ret, 2024 DB_RETOK_STD(ret), "set_re_delim"); 2025 } 2026 break; 2027 case TCL_DB_LEN: 2028 if (i >= objc) { 2029 Tcl_WrongNumArgs(interp, 2, objv, 2030 "-len length"); 2031 result = TCL_ERROR; 2032 break; 2033 } 2034 result = _GetUInt32(interp, objv[i++], &uintarg); 2035 if (result == TCL_OK) { 2036 _debug_check(); 2037 ret = (*dbp)->set_re_len(*dbp, uintarg); 2038 result = _ReturnSetup(interp, ret, 2039 DB_RETOK_STD(ret), "set_re_len"); 2040 } 2041 break; 2042 case TCL_DB_MAXSIZE: 2043 if (i >= objc) { 2044 Tcl_WrongNumArgs(interp, 2, objv, 2045 "-len length"); 2046 result = TCL_ERROR; 2047 break; 2048 } 2049 result = _GetUInt32(interp, objv[i++], &uintarg); 2050 if (result == TCL_OK) { 2051 _debug_check(); 2052 ret = (*dbp)->mpf->set_maxsize( 2053 (*dbp)->mpf, 0, uintarg); 2054 result = _ReturnSetup(interp, ret, 2055 DB_RETOK_STD(ret), "set_maxsize"); 2056 } 2057 break; 2058 case TCL_DB_PAD: 2059 if (i >= objc) { 2060 Tcl_WrongNumArgs(interp, 2, objv, 2061 "-pad pad"); 2062 result = TCL_ERROR; 2063 break; 2064 } 2065 result = Tcl_GetIntFromObj(interp, objv[i++], &intarg); 2066 if (result == TCL_OK) { 2067 _debug_check(); 2068 ret = (*dbp)->set_re_pad(*dbp, intarg); 2069 result = _ReturnSetup(interp, ret, 2070 DB_RETOK_STD(ret), "set_re_pad"); 2071 } 2072 break; 2073 case TCL_DB_SOURCE: 2074 if (i >= objc) { 2075 Tcl_WrongNumArgs(interp, 2, objv, 2076 "-source file"); 2077 result = TCL_ERROR; 2078 break; 2079 } 2080 arg = Tcl_GetStringFromObj(objv[i++], NULL); 2081 _debug_check(); 2082 ret = (*dbp)->set_re_source(*dbp, arg); 2083 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 2084 "set_re_source"); 2085 break; 2086 case TCL_DB_EXTENT: 2087 if (i >= objc) { 2088 Tcl_WrongNumArgs(interp, 2, objv, 2089 "-extent size"); 2090 result = TCL_ERROR; 2091 break; 2092 } 2093 result = _GetUInt32(interp, objv[i++], &uintarg); 2094 if (result == TCL_OK) { 2095 _debug_check(); 2096 ret = (*dbp)->set_q_extentsize(*dbp, uintarg); 2097 result = _ReturnSetup(interp, ret, 2098 DB_RETOK_STD(ret), "set_q_extentsize"); 2099 } 2100 break; 2101 case TCL_DB_CACHESIZE: 2102 result = Tcl_ListObjGetElements(interp, objv[i++], 2103 &myobjc, &myobjv); 2104 if (result != TCL_OK) 2105 break; 2106 if (myobjc != 3) { 2107 Tcl_WrongNumArgs(interp, 2, objv, 2108 "?-cachesize {gbytes bytes ncaches}?"); 2109 result = TCL_ERROR; 2110 break; 2111 } 2112 result = _GetUInt32(interp, myobjv[0], &gbytes); 2113 if (result != TCL_OK) 2114 break; 2115 result = _GetUInt32(interp, myobjv[1], &bytes); 2116 if (result != TCL_OK) 2117 break; 2118 result = Tcl_GetIntFromObj(interp, myobjv[2], &ncaches); 2119 if (result != TCL_OK) 2120 break; 2121 _debug_check(); 2122 ret = (*dbp)->set_cachesize(*dbp, gbytes, bytes, 2123 ncaches); 2124 result = _ReturnSetup(interp, ret, 2125 DB_RETOK_STD(ret), "set_cachesize"); 2126 break; 2127 case TCL_DB_PAGESIZE: 2128 if (i >= objc) { 2129 Tcl_WrongNumArgs(interp, 2, objv, 2130 "?-pagesize size?"); 2131 result = TCL_ERROR; 2132 break; 2133 } 2134 result = Tcl_GetIntFromObj(interp, objv[i++], &intarg); 2135 if (result == TCL_OK) { 2136 _debug_check(); 2137 ret = (*dbp)->set_pagesize(*dbp, 2138 (size_t)intarg); 2139 result = _ReturnSetup(interp, ret, 2140 DB_RETOK_STD(ret), "set pagesize"); 2141 } 2142 break; 2143 case TCL_DB_ERRFILE: 2144 if (i >= objc) { 2145 Tcl_WrongNumArgs(interp, 2, objv, 2146 "-errfile file"); 2147 result = TCL_ERROR; 2148 break; 2149 } 2150 arg = Tcl_GetStringFromObj(objv[i++], NULL); 2151 /* 2152 * If the user already set one, close it. 2153 */ 2154 if (errip->i_err != NULL && 2155 errip->i_err != stdout && errip->i_err != stderr) 2156 (void)fclose(errip->i_err); 2157 if (strcmp(arg, "/dev/stdout") == 0) 2158 errip->i_err = stdout; 2159 else if (strcmp(arg, "/dev/stderr") == 0) 2160 errip->i_err = stderr; 2161 else 2162 errip->i_err = fopen(arg, "a"); 2163 if (errip->i_err != NULL) { 2164 _debug_check(); 2165 (*dbp)->set_errfile(*dbp, errip->i_err); 2166 set_err = 1; 2167 } 2168 break; 2169 case TCL_DB_ERRPFX: 2170 if (i >= objc) { 2171 Tcl_WrongNumArgs(interp, 2, objv, 2172 "-errpfx prefix"); 2173 result = TCL_ERROR; 2174 break; 2175 } 2176 arg = Tcl_GetStringFromObj(objv[i++], NULL); 2177 /* 2178 * If the user already set one, free it. 2179 */ 2180 if (errip->i_errpfx != NULL) 2181 __os_free(NULL, errip->i_errpfx); 2182 if ((ret = __os_strdup((*dbp)->env, 2183 arg, &errip->i_errpfx)) != 0) { 2184 result = _ReturnSetup(interp, ret, 2185 DB_RETOK_STD(ret), "__os_strdup"); 2186 break; 2187 } 2188 if (errip->i_errpfx != NULL) { 2189 _debug_check(); 2190 (*dbp)->set_errpfx(*dbp, errip->i_errpfx); 2191 set_pfx = 1; 2192 } 2193 break; 2194 case TCL_DB_ENDARG: 2195 endarg = 1; 2196 break; 2197 } /* switch */ 2198 2199 /* 2200 * If, at any time, parsing the args we get an error, 2201 * bail out and return. 2202 */ 2203 if (result != TCL_OK) 2204 goto error; 2205 if (endarg) 2206 break; 2207 } 2208 if (result != TCL_OK) 2209 goto error; 2210 2211 /* 2212 * Any args we have left, (better be 0, 1 or 2 left) are 2213 * file names. If we have 0, then an in-memory db. If 2214 * there is 1, a db name, if 2 a db and subdb name. 2215 */ 2216 if (i != objc) { 2217 /* 2218 * Dbs must be NULL terminated file names, but subdbs can 2219 * be anything. Use Strings for the db name and byte 2220 * arrays for the subdb. 2221 */ 2222 db = Tcl_GetStringFromObj(objv[i++], NULL); 2223 if (strcmp(db, "") == 0) 2224 db = NULL; 2225 if (i != objc) { 2226 subdbtmp = 2227 Tcl_GetByteArrayFromObj(objv[i++], &subdblen); 2228 if ((ret = __os_malloc(env, 2229 (size_t)subdblen + 1, &subdb)) != 0) { 2230 Tcl_SetResult(interp, db_strerror(ret), 2231 TCL_STATIC); 2232 return (0); 2233 } 2234 memcpy(subdb, subdbtmp, (size_t)subdblen); 2235 subdb[subdblen] = '\0'; 2236 } 2237 } 2238 if (set_flags) { 2239 ret = (*dbp)->set_flags(*dbp, set_flags); 2240 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 2241 "set_flags"); 2242 if (result == TCL_ERROR) 2243 goto error; 2244 /* 2245 * If we are successful, clear the result so that the 2246 * return from set_flags isn't part of the result. 2247 */ 2248 Tcl_ResetResult(interp); 2249 } 2250 2251 /* 2252 * When we get here, we have already parsed all of our args and made 2253 * all our calls to set up the database. Everything is okay so far, 2254 * no errors, if we get here. 2255 */ 2256 _debug_check(); 2257 2258 /* Open the database. */ 2259 ret = (*dbp)->open(*dbp, txn, db, subdb, type, open_flags, mode); 2260 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db open"); 2261 2262error: 2263 if (subdb) 2264 __os_free(env, subdb); 2265 if (result == TCL_ERROR) { 2266 (void)(*dbp)->close(*dbp, 0); 2267 /* 2268 * If we opened and set up the error file in the environment 2269 * on this open, but we failed for some other reason, clean 2270 * up and close the file. 2271 * 2272 * XXX when err stuff isn't tied to env, change to use ip, 2273 * instead of envip. Also, set_err is irrelevant when that 2274 * happens. It will just read: 2275 * if (ip->i_err) 2276 * fclose(ip->i_err); 2277 */ 2278 if (set_err && errip && errip->i_err != NULL && 2279 errip->i_err != stdout && errip->i_err != stderr) { 2280 (void)fclose(errip->i_err); 2281 errip->i_err = NULL; 2282 } 2283 if (set_pfx && errip && errip->i_errpfx != NULL) { 2284 __os_free(env, errip->i_errpfx); 2285 errip->i_errpfx = NULL; 2286 } 2287 *dbp = NULL; 2288 } 2289 return (result); 2290} 2291 2292#ifdef HAVE_64BIT_TYPES 2293/* 2294 * bdb_SeqOpen -- 2295 * Implements the "Seq_create/Seq_open" command. 2296 */ 2297static int 2298bdb_SeqOpen(interp, objc, objv, ip, seqp) 2299 Tcl_Interp *interp; /* Interpreter */ 2300 int objc; /* How many arguments? */ 2301 Tcl_Obj *CONST objv[]; /* The argument objects */ 2302 DBTCL_INFO *ip; /* Our internal info */ 2303 DB_SEQUENCE **seqp; /* DB_SEQUENCE handle */ 2304{ 2305 static const char *seqopen[] = { 2306 "-cachesize", 2307 "-create", 2308 "-inc", 2309 "-init", 2310 "-dec", 2311 "-max", 2312 "-min", 2313 "-thread", 2314 "-txn", 2315 "-wrap", 2316 "--", 2317 NULL 2318 } ; 2319 enum seqopen { 2320 TCL_SEQ_CACHESIZE, 2321 TCL_SEQ_CREATE, 2322 TCL_SEQ_INC, 2323 TCL_SEQ_INIT, 2324 TCL_SEQ_DEC, 2325 TCL_SEQ_MAX, 2326 TCL_SEQ_MIN, 2327 TCL_SEQ_THREAD, 2328 TCL_SEQ_TXN, 2329 TCL_SEQ_WRAP, 2330 TCL_SEQ_ENDARG 2331 }; 2332 DB *dbp; 2333 DBT key; 2334 DBTYPE type; 2335 DB_TXN *txn; 2336 db_recno_t recno; 2337 db_seq_t min, max, value; 2338 Tcl_WideInt tcl_value; 2339 u_int32_t flags, oflags; 2340 int cache, endarg, i, optindex, result, ret, setrange, setvalue, v; 2341 char *arg, *db, msg[MSG_SIZE]; 2342 2343 COMPQUIET(ip, NULL); 2344 COMPQUIET(value, 0); 2345 *seqp = NULL; 2346 2347 if (objc < 2) { 2348 Tcl_WrongNumArgs(interp, 2, objv, "?args?"); 2349 return (TCL_ERROR); 2350 } 2351 2352 txn = NULL; 2353 endarg = 0; 2354 flags = oflags = 0; 2355 setrange = setvalue = 0; 2356 min = INT64_MIN; 2357 max = INT64_MAX; 2358 cache = 0; 2359 2360 for (i = 2; i < objc;) { 2361 Tcl_ResetResult(interp); 2362 if (Tcl_GetIndexFromObj(interp, objv[i], seqopen, "option", 2363 TCL_EXACT, &optindex) != TCL_OK) { 2364 arg = Tcl_GetStringFromObj(objv[i], NULL); 2365 if (arg[0] == '-') { 2366 result = IS_HELP(objv[i]); 2367 goto error; 2368 } else 2369 Tcl_ResetResult(interp); 2370 break; 2371 } 2372 i++; 2373 result = TCL_OK; 2374 switch ((enum seqopen)optindex) { 2375 case TCL_SEQ_CREATE: 2376 oflags |= DB_CREATE; 2377 break; 2378 case TCL_SEQ_INC: 2379 LF_SET(DB_SEQ_INC); 2380 break; 2381 case TCL_SEQ_CACHESIZE: 2382 if (i >= objc) { 2383 Tcl_WrongNumArgs(interp, 2, objv, 2384 "?-cachesize value?"); 2385 result = TCL_ERROR; 2386 break; 2387 } 2388 result = Tcl_GetIntFromObj(interp, objv[i++], &cache); 2389 break; 2390 case TCL_SEQ_INIT: 2391 if (i >= objc) { 2392 Tcl_WrongNumArgs(interp, 2, objv, 2393 "?-init value?"); 2394 result = TCL_ERROR; 2395 break; 2396 } 2397 result = 2398 Tcl_GetWideIntFromObj( 2399 interp, objv[i++], &tcl_value); 2400 value = tcl_value; 2401 setvalue = 1; 2402 break; 2403 case TCL_SEQ_DEC: 2404 LF_SET(DB_SEQ_DEC); 2405 break; 2406 case TCL_SEQ_MAX: 2407 if (i >= objc) { 2408 Tcl_WrongNumArgs(interp, 2, objv, 2409 "?-max value?"); 2410 result = TCL_ERROR; 2411 break; 2412 } 2413 if ((result = 2414 Tcl_GetWideIntFromObj(interp, 2415 objv[i++], &tcl_value)) != TCL_OK) 2416 goto error; 2417 max = tcl_value; 2418 setrange = 1; 2419 break; 2420 case TCL_SEQ_MIN: 2421 if (i >= objc) { 2422 Tcl_WrongNumArgs(interp, 2, objv, 2423 "?-min value?"); 2424 result = TCL_ERROR; 2425 break; 2426 } 2427 if ((result = 2428 Tcl_GetWideIntFromObj(interp, 2429 objv[i++], &tcl_value)) != TCL_OK) 2430 goto error; 2431 min = tcl_value; 2432 setrange = 1; 2433 break; 2434 case TCL_SEQ_THREAD: 2435 oflags |= DB_THREAD; 2436 break; 2437 case TCL_SEQ_TXN: 2438 if (i > (objc - 1)) { 2439 Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?"); 2440 result = TCL_ERROR; 2441 break; 2442 } 2443 arg = Tcl_GetStringFromObj(objv[i++], NULL); 2444 txn = NAME_TO_TXN(arg); 2445 if (txn == NULL) { 2446 snprintf(msg, MSG_SIZE, 2447 "Sequence: Invalid txn: %s\n", arg); 2448 Tcl_SetResult(interp, msg, TCL_VOLATILE); 2449 result = TCL_ERROR; 2450 } 2451 break; 2452 case TCL_SEQ_WRAP: 2453 LF_SET(DB_SEQ_WRAP); 2454 break; 2455 case TCL_SEQ_ENDARG: 2456 endarg = 1; 2457 break; 2458 } 2459 /* 2460 * If, at any time, parsing the args we get an error, 2461 * bail out and return. 2462 */ 2463 if (result != TCL_OK) 2464 goto error; 2465 if (endarg) 2466 break; 2467 } 2468 2469 if (objc - i != 2) { 2470 Tcl_WrongNumArgs(interp, 2, objv, "?args?"); 2471 return (TCL_ERROR); 2472 } 2473 /* 2474 * The db must be a string but the sequence key may 2475 * be anything. 2476 */ 2477 db = Tcl_GetStringFromObj(objv[i++], NULL); 2478 if ((dbp = NAME_TO_DB(db)) == NULL) { 2479 Tcl_SetResult(interp, "No such dbp", TCL_STATIC); 2480 return (TCL_ERROR); 2481 } 2482 (void)dbp->get_type(dbp, &type); 2483 2484 if (type == DB_QUEUE || type == DB_RECNO) { 2485 result = _GetUInt32(interp, objv[i++], &recno); 2486 if (result != TCL_OK) 2487 return (result); 2488 DB_INIT_DBT(key, &recno, sizeof(recno)); 2489 } else 2490 DB_INIT_DBT(key, Tcl_GetByteArrayFromObj(objv[i++], &v), v); 2491 ret = db_sequence_create(seqp, dbp, 0); 2492 if ((result = _ReturnSetup(interp, 2493 ret, DB_RETOK_STD(ret), "sequence create")) != TCL_OK) { 2494 *seqp = NULL; 2495 return (result); 2496 } 2497 2498 ret = (*seqp)->set_flags(*seqp, flags); 2499 if ((result = _ReturnSetup(interp, 2500 ret, DB_RETOK_STD(ret), "sequence set_flags")) != TCL_OK) 2501 goto error; 2502 if (setrange) { 2503 ret = (*seqp)->set_range(*seqp, min, max); 2504 if ((result = _ReturnSetup(interp, 2505 ret, DB_RETOK_STD(ret), "sequence set_range")) != TCL_OK) 2506 goto error; 2507 } 2508 if (cache) { 2509 ret = (*seqp)->set_cachesize(*seqp, cache); 2510 if ((result = _ReturnSetup(interp, 2511 ret, DB_RETOK_STD(ret), "sequence cachesize")) != TCL_OK) 2512 goto error; 2513 } 2514 if (setvalue) { 2515 ret = (*seqp)->initial_value(*seqp, value); 2516 if ((result = _ReturnSetup(interp, 2517 ret, DB_RETOK_STD(ret), "sequence init")) != TCL_OK) 2518 goto error; 2519 } 2520 ret = (*seqp)->open(*seqp, txn, &key, oflags); 2521 if ((result = _ReturnSetup(interp, 2522 ret, DB_RETOK_STD(ret), "sequence open")) != TCL_OK) 2523 goto error; 2524 2525 if (0) { 2526error: if (*seqp != NULL) 2527 (void)(*seqp)->close(*seqp, 0); 2528 *seqp = NULL; 2529 } 2530 return (result); 2531} 2532#endif 2533 2534/* 2535 * bdb_DbRemove -- 2536 * Implements the DB_ENV->remove and DB->remove command. 2537 */ 2538static int 2539bdb_DbRemove(interp, objc, objv) 2540 Tcl_Interp *interp; /* Interpreter */ 2541 int objc; /* How many arguments? */ 2542 Tcl_Obj *CONST objv[]; /* The argument objects */ 2543{ 2544 static const char *bdbrem[] = { 2545 "-auto_commit", 2546 "-encrypt", 2547 "-encryptaes", 2548 "-encryptany", 2549 "-env", 2550 "-txn", 2551 "--", 2552 NULL 2553 }; 2554 enum bdbrem { 2555 TCL_DBREM_AUTOCOMMIT, 2556 TCL_DBREM_ENCRYPT, 2557 TCL_DBREM_ENCRYPT_AES, 2558 TCL_DBREM_ENCRYPT_ANY, 2559 TCL_DBREM_ENV, 2560 TCL_DBREM_TXN, 2561 TCL_DBREM_ENDARG 2562 }; 2563 DB *dbp; 2564 DB_ENV *dbenv; 2565 DB_TXN *txn; 2566 ENV *env; 2567 u_int32_t enc_flag, iflags, set_flags; 2568 int endarg, i, optindex, result, ret, subdblen; 2569 u_char *subdbtmp; 2570 char *arg, *db, msg[MSG_SIZE], *passwd, *subdb; 2571 2572 dbp = NULL; 2573 dbenv = NULL; 2574 txn = NULL; 2575 env = NULL; 2576 enc_flag = iflags = set_flags = 0; 2577 endarg = 0; 2578 result = TCL_OK; 2579 subdbtmp = NULL; 2580 db = passwd = subdb = NULL; 2581 2582 if (objc < 2) { 2583 Tcl_WrongNumArgs(interp, 2, objv, "?args? filename ?database?"); 2584 return (TCL_ERROR); 2585 } 2586 2587 /* 2588 * We must first parse for the environment flag, since that 2589 * is needed for db_create. Then create the db handle. 2590 */ 2591 i = 2; 2592 while (i < objc) { 2593 if (Tcl_GetIndexFromObj(interp, objv[i], bdbrem, 2594 "option", TCL_EXACT, &optindex) != TCL_OK) { 2595 arg = Tcl_GetStringFromObj(objv[i], NULL); 2596 if (arg[0] == '-') { 2597 result = IS_HELP(objv[i]); 2598 goto error; 2599 } else 2600 Tcl_ResetResult(interp); 2601 break; 2602 } 2603 i++; 2604 switch ((enum bdbrem)optindex) { 2605 case TCL_DBREM_AUTOCOMMIT: 2606 iflags |= DB_AUTO_COMMIT; 2607 _debug_check(); 2608 break; 2609 case TCL_DBREM_ENCRYPT: 2610 set_flags |= DB_ENCRYPT; 2611 _debug_check(); 2612 break; 2613 case TCL_DBREM_ENCRYPT_AES: 2614 /* Make sure we have an arg to check against! */ 2615 if (i >= objc) { 2616 Tcl_WrongNumArgs(interp, 2, objv, 2617 "?-encryptaes passwd?"); 2618 result = TCL_ERROR; 2619 break; 2620 } 2621 passwd = Tcl_GetStringFromObj(objv[i++], NULL); 2622 enc_flag = DB_ENCRYPT_AES; 2623 break; 2624 case TCL_DBREM_ENCRYPT_ANY: 2625 /* Make sure we have an arg to check against! */ 2626 if (i >= objc) { 2627 Tcl_WrongNumArgs(interp, 2, objv, 2628 "?-encryptany passwd?"); 2629 result = TCL_ERROR; 2630 break; 2631 } 2632 passwd = Tcl_GetStringFromObj(objv[i++], NULL); 2633 enc_flag = 0; 2634 break; 2635 case TCL_DBREM_ENV: 2636 arg = Tcl_GetStringFromObj(objv[i++], NULL); 2637 dbenv = NAME_TO_ENV(arg); 2638 if (dbenv == NULL) { 2639 Tcl_SetResult(interp, 2640 "db remove: illegal environment", 2641 TCL_STATIC); 2642 return (TCL_ERROR); 2643 } 2644 env = dbenv->env; 2645 break; 2646 case TCL_DBREM_ENDARG: 2647 endarg = 1; 2648 break; 2649 case TCL_DBREM_TXN: 2650 if (i >= objc) { 2651 Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?"); 2652 result = TCL_ERROR; 2653 break; 2654 } 2655 arg = Tcl_GetStringFromObj(objv[i++], NULL); 2656 txn = NAME_TO_TXN(arg); 2657 if (txn == NULL) { 2658 snprintf(msg, MSG_SIZE, 2659 "Put: Invalid txn: %s\n", arg); 2660 Tcl_SetResult(interp, msg, TCL_VOLATILE); 2661 result = TCL_ERROR; 2662 } 2663 break; 2664 } 2665 /* 2666 * If, at any time, parsing the args we get an error, 2667 * bail out and return. 2668 */ 2669 if (result != TCL_OK) 2670 goto error; 2671 if (endarg) 2672 break; 2673 } 2674 if (result != TCL_OK) 2675 goto error; 2676 /* 2677 * Any args we have left, (better be 1 or 2 left) are 2678 * file names. If there is 1, a db name, if 2 a db and subdb name. 2679 */ 2680 if ((i != (objc - 1)) || (i != (objc - 2))) { 2681 /* 2682 * Dbs must be NULL terminated file names, but subdbs can 2683 * be anything. Use Strings for the db name and byte 2684 * arrays for the subdb. 2685 */ 2686 db = Tcl_GetStringFromObj(objv[i++], NULL); 2687 if (strcmp(db, "") == 0) 2688 db = NULL; 2689 if (i != objc) { 2690 subdbtmp = 2691 Tcl_GetByteArrayFromObj(objv[i++], &subdblen); 2692 if ((ret = __os_malloc(env, (size_t)subdblen + 1, 2693 &subdb)) != 0) { Tcl_SetResult(interp, 2694 db_strerror(ret), TCL_STATIC); 2695 return (0); 2696 } 2697 memcpy(subdb, subdbtmp, (size_t)subdblen); 2698 subdb[subdblen] = '\0'; 2699 } 2700 } else { 2701 Tcl_WrongNumArgs(interp, 2, objv, "?args? filename ?database?"); 2702 result = TCL_ERROR; 2703 goto error; 2704 } 2705 if (dbenv == NULL) { 2706 ret = db_create(&dbp, dbenv, 0); 2707 if (ret) { 2708 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 2709 "db_create"); 2710 goto error; 2711 } 2712 2713 /* 2714 * XXX 2715 * Remove restriction if error handling not tied to env. 2716 * 2717 * The DB->set_err* functions overwrite the environment. So, if 2718 * we are using an env, don't overwrite it; if not using an env, 2719 * then configure error handling. 2720 */ 2721 dbp->set_errpfx(dbp, "DbRemove"); 2722 dbp->set_errcall(dbp, _ErrorFunc); 2723 2724 if (passwd != NULL) { 2725 ret = dbp->set_encrypt(dbp, passwd, enc_flag); 2726 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 2727 "set_encrypt"); 2728 } 2729 if (set_flags != 0) { 2730 ret = dbp->set_flags(dbp, set_flags); 2731 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 2732 "set_flags"); 2733 } 2734 } 2735 2736 /* 2737 * The dbremove method is a destructor, NULL out the dbp. 2738 */ 2739 _debug_check(); 2740 if (dbp == NULL) 2741 ret = dbenv->dbremove(dbenv, txn, db, subdb, iflags); 2742 else 2743 ret = dbp->remove(dbp, db, subdb, 0); 2744 2745 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db remove"); 2746 dbp = NULL; 2747error: 2748 if (subdb) 2749 __os_free(env, subdb); 2750 if (result == TCL_ERROR && dbp != NULL) 2751 (void)dbp->close(dbp, 0); 2752 return (result); 2753} 2754 2755/* 2756 * bdb_DbRename -- 2757 * Implements the DB_ENV->dbrename and DB->rename commands. 2758 */ 2759static int 2760bdb_DbRename(interp, objc, objv) 2761 Tcl_Interp *interp; /* Interpreter */ 2762 int objc; /* How many arguments? */ 2763 Tcl_Obj *CONST objv[]; /* The argument objects */ 2764{ 2765 static const char *bdbmv[] = { 2766 "-auto_commit", 2767 "-encrypt", 2768 "-encryptaes", 2769 "-encryptany", 2770 "-env", 2771 "-txn", 2772 "--", 2773 NULL 2774 }; 2775 enum bdbmv { 2776 TCL_DBMV_AUTOCOMMIT, 2777 TCL_DBMV_ENCRYPT, 2778 TCL_DBMV_ENCRYPT_AES, 2779 TCL_DBMV_ENCRYPT_ANY, 2780 TCL_DBMV_ENV, 2781 TCL_DBMV_TXN, 2782 TCL_DBMV_ENDARG 2783 }; 2784 DB *dbp; 2785 DB_ENV *dbenv; 2786 DB_TXN *txn; 2787 ENV *env; 2788 u_int32_t enc_flag, iflags, set_flags; 2789 int endarg, i, newlen, optindex, result, ret, subdblen; 2790 u_char *subdbtmp; 2791 char *arg, *db, msg[MSG_SIZE], *newname, *passwd, *subdb; 2792 2793 dbp = NULL; 2794 dbenv = NULL; 2795 txn = NULL; 2796 env = NULL; 2797 enc_flag = iflags = set_flags = 0; 2798 result = TCL_OK; 2799 endarg = 0; 2800 db = newname = passwd = subdb = NULL; 2801 subdbtmp = NULL; 2802 2803 if (objc < 2) { 2804 Tcl_WrongNumArgs(interp, 2805 3, objv, "?args? filename ?database? ?newname?"); 2806 return (TCL_ERROR); 2807 } 2808 2809 /* 2810 * We must first parse for the environment flag, since that 2811 * is needed for db_create. Then create the db handle. 2812 */ 2813 i = 2; 2814 while (i < objc) { 2815 if (Tcl_GetIndexFromObj(interp, objv[i], bdbmv, 2816 "option", TCL_EXACT, &optindex) != TCL_OK) { 2817 arg = Tcl_GetStringFromObj(objv[i], NULL); 2818 if (arg[0] == '-') { 2819 result = IS_HELP(objv[i]); 2820 goto error; 2821 } else 2822 Tcl_ResetResult(interp); 2823 break; 2824 } 2825 i++; 2826 switch ((enum bdbmv)optindex) { 2827 case TCL_DBMV_AUTOCOMMIT: 2828 iflags |= DB_AUTO_COMMIT; 2829 _debug_check(); 2830 break; 2831 case TCL_DBMV_ENCRYPT: 2832 set_flags |= DB_ENCRYPT; 2833 _debug_check(); 2834 break; 2835 case TCL_DBMV_ENCRYPT_AES: 2836 /* Make sure we have an arg to check against! */ 2837 if (i >= objc) { 2838 Tcl_WrongNumArgs(interp, 2, objv, 2839 "?-encryptaes passwd?"); 2840 result = TCL_ERROR; 2841 break; 2842 } 2843 passwd = Tcl_GetStringFromObj(objv[i++], NULL); 2844 enc_flag = DB_ENCRYPT_AES; 2845 break; 2846 case TCL_DBMV_ENCRYPT_ANY: 2847 /* Make sure we have an arg to check against! */ 2848 if (i >= objc) { 2849 Tcl_WrongNumArgs(interp, 2, objv, 2850 "?-encryptany passwd?"); 2851 result = TCL_ERROR; 2852 break; 2853 } 2854 passwd = Tcl_GetStringFromObj(objv[i++], NULL); 2855 enc_flag = 0; 2856 break; 2857 case TCL_DBMV_ENV: 2858 arg = Tcl_GetStringFromObj(objv[i++], NULL); 2859 dbenv = NAME_TO_ENV(arg); 2860 if (dbenv == NULL) { 2861 Tcl_SetResult(interp, 2862 "db rename: illegal environment", 2863 TCL_STATIC); 2864 return (TCL_ERROR); 2865 } 2866 env = dbenv->env; 2867 break; 2868 case TCL_DBMV_ENDARG: 2869 endarg = 1; 2870 break; 2871 case TCL_DBMV_TXN: 2872 if (i >= objc) { 2873 Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?"); 2874 result = TCL_ERROR; 2875 break; 2876 } 2877 arg = Tcl_GetStringFromObj(objv[i++], NULL); 2878 txn = NAME_TO_TXN(arg); 2879 if (txn == NULL) { 2880 snprintf(msg, MSG_SIZE, 2881 "Put: Invalid txn: %s\n", arg); 2882 Tcl_SetResult(interp, msg, TCL_VOLATILE); 2883 result = TCL_ERROR; 2884 } 2885 break; 2886 } 2887 /* 2888 * If, at any time, parsing the args we get an error, 2889 * bail out and return. 2890 */ 2891 if (result != TCL_OK) 2892 goto error; 2893 if (endarg) 2894 break; 2895 } 2896 if (result != TCL_OK) 2897 goto error; 2898 /* 2899 * Any args we have left, (better be 2 or 3 left) are 2900 * file names. If there is 2, a file name, if 3 a file and db name. 2901 */ 2902 if ((i != (objc - 2)) || (i != (objc - 3))) { 2903 /* 2904 * Dbs must be NULL terminated file names, but subdbs can 2905 * be anything. Use Strings for the db name and byte 2906 * arrays for the subdb. 2907 */ 2908 db = Tcl_GetStringFromObj(objv[i++], NULL); 2909 if (strcmp(db, "") == 0) 2910 db = NULL; 2911 if (i == objc - 2) { 2912 subdbtmp = 2913 Tcl_GetByteArrayFromObj(objv[i++], &subdblen); 2914 if ((ret = __os_malloc(env, 2915 (size_t)subdblen + 1, &subdb)) != 0) { 2916 Tcl_SetResult(interp, 2917 db_strerror(ret), TCL_STATIC); 2918 return (0); 2919 } 2920 memcpy(subdb, subdbtmp, (size_t)subdblen); 2921 subdb[subdblen] = '\0'; 2922 } 2923 subdbtmp = 2924 Tcl_GetByteArrayFromObj(objv[i++], &newlen); 2925 if ((ret = __os_malloc( 2926 env, (size_t)newlen + 1, &newname)) != 0) { 2927 Tcl_SetResult(interp, 2928 db_strerror(ret), TCL_STATIC); 2929 return (0); 2930 } 2931 memcpy(newname, subdbtmp, (size_t)newlen); 2932 newname[newlen] = '\0'; 2933 } else { 2934 Tcl_WrongNumArgs( 2935 interp, 3, objv, "?args? filename ?database? ?newname?"); 2936 result = TCL_ERROR; 2937 goto error; 2938 } 2939 if (dbenv == NULL) { 2940 ret = db_create(&dbp, dbenv, 0); 2941 if (ret) { 2942 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 2943 "db_create"); 2944 goto error; 2945 } 2946 /* 2947 * XXX 2948 * Remove restriction if error handling not tied to env. 2949 * 2950 * The DB->set_err* functions overwrite the environment. So, if 2951 * we are using an env, don't overwrite it; if not using an env, 2952 * then configure error handling. 2953 */ 2954 dbp->set_errpfx(dbp, "DbRename"); 2955 dbp->set_errcall(dbp, _ErrorFunc); 2956 2957 if (passwd != NULL) { 2958 ret = dbp->set_encrypt(dbp, passwd, enc_flag); 2959 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 2960 "set_encrypt"); 2961 } 2962 if (set_flags != 0) { 2963 ret = dbp->set_flags(dbp, set_flags); 2964 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 2965 "set_flags"); 2966 } 2967 } 2968 2969 /* 2970 * The dbrename method is a destructor, NULL out the dbp. 2971 */ 2972 _debug_check(); 2973 if (dbp == NULL) 2974 ret = dbenv->dbrename(dbenv, txn, db, subdb, newname, iflags); 2975 else 2976 ret = dbp->rename(dbp, db, subdb, newname, 0); 2977 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db rename"); 2978 dbp = NULL; 2979error: 2980 if (subdb) 2981 __os_free(env, subdb); 2982 if (newname) 2983 __os_free(env, newname); 2984 if (result == TCL_ERROR && dbp != NULL) 2985 (void)dbp->close(dbp, 0); 2986 return (result); 2987} 2988 2989#ifdef CONFIG_TEST 2990/* 2991 * bdb_DbVerify -- 2992 * Implements the DB->verify command. 2993 */ 2994static int 2995bdb_DbVerify(interp, objc, objv) 2996 Tcl_Interp *interp; /* Interpreter */ 2997 int objc; /* How many arguments? */ 2998 Tcl_Obj *CONST objv[]; /* The argument objects */ 2999{ 3000 static const char *bdbverify[] = { 3001 "-encrypt", 3002 "-encryptaes", 3003 "-encryptany", 3004 "-env", 3005 "-errfile", 3006 "-errpfx", 3007 "-noorderchk", 3008 "-orderchkonly", 3009 "-unref", 3010 "--", 3011 NULL 3012 }; 3013 enum bdbvrfy { 3014 TCL_DBVRFY_ENCRYPT, 3015 TCL_DBVRFY_ENCRYPT_AES, 3016 TCL_DBVRFY_ENCRYPT_ANY, 3017 TCL_DBVRFY_ENV, 3018 TCL_DBVRFY_ERRFILE, 3019 TCL_DBVRFY_ERRPFX, 3020 TCL_DBVRFY_NOORDERCHK, 3021 TCL_DBVRFY_ORDERCHKONLY, 3022 TCL_DBVRFY_UNREF, 3023 TCL_DBVRFY_ENDARG 3024 }; 3025 DB_ENV *dbenv; 3026 DB *dbp; 3027 FILE *errf; 3028 u_int32_t enc_flag, flags, set_flags; 3029 int endarg, i, optindex, result, ret, subdblen; 3030 char *arg, *db, *errpfx, *passwd, *subdb; 3031 u_char *subdbtmp; 3032 3033 dbenv = NULL; 3034 dbp = NULL; 3035 passwd = NULL; 3036 result = TCL_OK; 3037 db = errpfx = subdb = NULL; 3038 errf = NULL; 3039 flags = endarg = 0; 3040 enc_flag = set_flags = 0; 3041 3042 if (objc < 2) { 3043 Tcl_WrongNumArgs(interp, 2, objv, "?args? filename"); 3044 return (TCL_ERROR); 3045 } 3046 3047 /* 3048 * We must first parse for the environment flag, since that 3049 * is needed for db_create. Then create the db handle. 3050 */ 3051 i = 2; 3052 while (i < objc) { 3053 if (Tcl_GetIndexFromObj(interp, objv[i], bdbverify, 3054 "option", TCL_EXACT, &optindex) != TCL_OK) { 3055 arg = Tcl_GetStringFromObj(objv[i], NULL); 3056 if (arg[0] == '-') { 3057 result = IS_HELP(objv[i]); 3058 goto error; 3059 } else 3060 Tcl_ResetResult(interp); 3061 break; 3062 } 3063 i++; 3064 switch ((enum bdbvrfy)optindex) { 3065 case TCL_DBVRFY_ENCRYPT: 3066 set_flags |= DB_ENCRYPT; 3067 _debug_check(); 3068 break; 3069 case TCL_DBVRFY_ENCRYPT_AES: 3070 /* Make sure we have an arg to check against! */ 3071 if (i >= objc) { 3072 Tcl_WrongNumArgs(interp, 2, objv, 3073 "?-encryptaes passwd?"); 3074 result = TCL_ERROR; 3075 break; 3076 } 3077 passwd = Tcl_GetStringFromObj(objv[i++], NULL); 3078 enc_flag = DB_ENCRYPT_AES; 3079 break; 3080 case TCL_DBVRFY_ENCRYPT_ANY: 3081 /* Make sure we have an arg to check against! */ 3082 if (i >= objc) { 3083 Tcl_WrongNumArgs(interp, 2, objv, 3084 "?-encryptany passwd?"); 3085 result = TCL_ERROR; 3086 break; 3087 } 3088 passwd = Tcl_GetStringFromObj(objv[i++], NULL); 3089 enc_flag = 0; 3090 break; 3091 case TCL_DBVRFY_ENV: 3092 arg = Tcl_GetStringFromObj(objv[i++], NULL); 3093 dbenv = NAME_TO_ENV(arg); 3094 if (dbenv == NULL) { 3095 Tcl_SetResult(interp, 3096 "db verify: illegal environment", 3097 TCL_STATIC); 3098 result = TCL_ERROR; 3099 break; 3100 } 3101 break; 3102 case TCL_DBVRFY_ERRFILE: 3103 if (i >= objc) { 3104 Tcl_WrongNumArgs(interp, 2, objv, 3105 "-errfile file"); 3106 result = TCL_ERROR; 3107 break; 3108 } 3109 arg = Tcl_GetStringFromObj(objv[i++], NULL); 3110 /* 3111 * If the user already set one, close it. 3112 */ 3113 if (errf != NULL && errf != stdout && errf != stderr) 3114 (void)fclose(errf); 3115 if (strcmp(arg, "/dev/stdout") == 0) 3116 errf = stdout; 3117 else if (strcmp(arg, "/dev/stderr") == 0) 3118 errf = stderr; 3119 else 3120 errf = fopen(arg, "a"); 3121 break; 3122 case TCL_DBVRFY_ERRPFX: 3123 if (i >= objc) { 3124 Tcl_WrongNumArgs(interp, 2, objv, 3125 "-errpfx prefix"); 3126 result = TCL_ERROR; 3127 break; 3128 } 3129 arg = Tcl_GetStringFromObj(objv[i++], NULL); 3130 /* 3131 * If the user already set one, free it. 3132 */ 3133 if (errpfx != NULL) 3134 __os_free(dbenv->env, errpfx); 3135 if ((ret = __os_strdup(NULL, arg, &errpfx)) != 0) { 3136 result = _ReturnSetup(interp, ret, 3137 DB_RETOK_STD(ret), "__os_strdup"); 3138 break; 3139 } 3140 break; 3141 case TCL_DBVRFY_NOORDERCHK: 3142 flags |= DB_NOORDERCHK; 3143 break; 3144 case TCL_DBVRFY_ORDERCHKONLY: 3145 flags |= DB_ORDERCHKONLY; 3146 break; 3147 case TCL_DBVRFY_UNREF: 3148 flags |= DB_UNREF; 3149 break; 3150 case TCL_DBVRFY_ENDARG: 3151 endarg = 1; 3152 break; 3153 } 3154 /* 3155 * If, at any time, parsing the args we get an error, 3156 * bail out and return. 3157 */ 3158 if (result != TCL_OK) 3159 goto error; 3160 if (endarg) 3161 break; 3162 } 3163 if (result != TCL_OK) 3164 goto error; 3165 /* 3166 * The remaining arg is the db filename. 3167 */ 3168 /* 3169 * Any args we have left, (better be 1 or 2 left) are 3170 * file names. If there is 1, a db name, if 2 a db and subdb name. 3171 */ 3172 if (i != objc) { 3173 /* 3174 * Dbs must be NULL terminated file names, but subdbs can 3175 * be anything. Use Strings for the db name and byte 3176 * arrays for the subdb. 3177 */ 3178 db = Tcl_GetStringFromObj(objv[i++], NULL); 3179 if (strcmp(db, "") == 0) 3180 db = NULL; 3181 if (i != objc) { 3182 subdbtmp = 3183 Tcl_GetByteArrayFromObj(objv[i++], &subdblen); 3184 if ((ret = __os_malloc(dbenv->env, 3185 (size_t)subdblen + 1, &subdb)) != 0) { 3186 Tcl_SetResult(interp, db_strerror(ret), 3187 TCL_STATIC); 3188 return (0); 3189 } 3190 memcpy(subdb, subdbtmp, (size_t)subdblen); 3191 subdb[subdblen] = '\0'; 3192 } 3193 } else { 3194 Tcl_WrongNumArgs(interp, 2, objv, "?args? filename"); 3195 result = TCL_ERROR; 3196 goto error; 3197 } 3198 ret = db_create(&dbp, dbenv, 0); 3199 if (ret) { 3200 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 3201 "db_create"); 3202 goto error; 3203 } 3204 3205 if (passwd != NULL) { 3206 ret = dbp->set_encrypt(dbp, passwd, enc_flag); 3207 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 3208 "set_encrypt"); 3209 } 3210 3211 if (set_flags != 0) { 3212 ret = dbp->set_flags(dbp, set_flags); 3213 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 3214 "set_flags"); 3215 } 3216 if (errf != NULL) 3217 dbp->set_errfile(dbp, errf); 3218 if (errpfx != NULL) 3219 dbp->set_errpfx(dbp, errpfx); 3220 3221 /* 3222 * The verify method is a destructor, NULL out the dbp. 3223 */ 3224 ret = dbp->verify(dbp, db, subdb, NULL, flags); 3225 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db verify"); 3226 dbp = NULL; 3227error: 3228 if (errf != NULL && errf != stdout && errf != stderr) 3229 (void)fclose(errf); 3230 if (errpfx != NULL) 3231 __os_free(dbenv->env, errpfx); 3232 if (dbp) 3233 (void)dbp->close(dbp, 0); 3234 return (result); 3235} 3236#endif 3237 3238/* 3239 * bdb_Version -- 3240 * Implements the version command. 3241 */ 3242static int 3243bdb_Version(interp, objc, objv) 3244 Tcl_Interp *interp; /* Interpreter */ 3245 int objc; /* How many arguments? */ 3246 Tcl_Obj *CONST objv[]; /* The argument objects */ 3247{ 3248 static const char *bdbver[] = { 3249 "-string", NULL 3250 }; 3251 enum bdbver { 3252 TCL_VERSTRING 3253 }; 3254 int i, optindex, maj, min, patch, result, string, verobjc; 3255 char *arg, *v; 3256 Tcl_Obj *res, *verobjv[3]; 3257 3258 result = TCL_OK; 3259 string = 0; 3260 3261 if (objc < 2) { 3262 Tcl_WrongNumArgs(interp, 2, objv, "?args?"); 3263 return (TCL_ERROR); 3264 } 3265 3266 /* 3267 * We must first parse for the environment flag, since that 3268 * is needed for db_create. Then create the db handle. 3269 */ 3270 i = 2; 3271 while (i < objc) { 3272 if (Tcl_GetIndexFromObj(interp, objv[i], bdbver, 3273 "option", TCL_EXACT, &optindex) != TCL_OK) { 3274 arg = Tcl_GetStringFromObj(objv[i], NULL); 3275 if (arg[0] == '-') { 3276 result = IS_HELP(objv[i]); 3277 goto error; 3278 } else 3279 Tcl_ResetResult(interp); 3280 break; 3281 } 3282 i++; 3283 switch ((enum bdbver)optindex) { 3284 case TCL_VERSTRING: 3285 string = 1; 3286 break; 3287 } 3288 /* 3289 * If, at any time, parsing the args we get an error, 3290 * bail out and return. 3291 */ 3292 if (result != TCL_OK) 3293 goto error; 3294 } 3295 if (result != TCL_OK) 3296 goto error; 3297 3298 v = db_version(&maj, &min, &patch); 3299 if (string) 3300 res = NewStringObj(v, strlen(v)); 3301 else { 3302 verobjc = 3; 3303 verobjv[0] = Tcl_NewIntObj(maj); 3304 verobjv[1] = Tcl_NewIntObj(min); 3305 verobjv[2] = Tcl_NewIntObj(patch); 3306 res = Tcl_NewListObj(verobjc, verobjv); 3307 } 3308 Tcl_SetObjResult(interp, res); 3309error: 3310 return (result); 3311} 3312 3313#ifdef CONFIG_TEST 3314/* 3315 * bdb_GetConfig -- 3316 * Implements the getconfig command. 3317 */ 3318#define ADD_CONFIG_NAME(name) \ 3319 conf = NewStringObj(name, strlen(name)); \ 3320 if (Tcl_ListObjAppendElement(interp, res, conf) != TCL_OK) \ 3321 return (TCL_ERROR); 3322 3323static int 3324bdb_GetConfig(interp, objc, objv) 3325 Tcl_Interp *interp; /* Interpreter */ 3326 int objc; /* How many arguments? */ 3327 Tcl_Obj *CONST objv[]; /* The argument objects */ 3328{ 3329 Tcl_Obj *res, *conf; 3330 3331 /* 3332 * No args. Error if we have some 3333 */ 3334 if (objc != 2) { 3335 Tcl_WrongNumArgs(interp, 2, objv, ""); 3336 return (TCL_ERROR); 3337 } 3338 res = Tcl_NewListObj(0, NULL); 3339 conf = NULL; 3340 3341 /* 3342 * This command conditionally adds strings in based on 3343 * how DB is configured so that the test suite can make 3344 * decisions based on that. For now only implement the 3345 * configuration pieces we need. 3346 */ 3347#ifdef DEBUG 3348 ADD_CONFIG_NAME("debug"); 3349#endif 3350#ifdef DEBUG_ROP 3351 ADD_CONFIG_NAME("debug_rop"); 3352#endif 3353#ifdef DEBUG_WOP 3354 ADD_CONFIG_NAME("debug_wop"); 3355#endif 3356#ifdef DIAGNOSTIC 3357 ADD_CONFIG_NAME("diagnostic"); 3358#endif 3359#ifdef HAVE_HASH 3360 ADD_CONFIG_NAME("hash"); 3361#endif 3362#ifdef HAVE_QUEUE 3363 ADD_CONFIG_NAME("queue"); 3364#endif 3365#ifdef HAVE_REPLICATION 3366 ADD_CONFIG_NAME("rep"); 3367#endif 3368#ifdef HAVE_REPLICATION_THREADS 3369 ADD_CONFIG_NAME("repmgr"); 3370#endif 3371#ifdef HAVE_RPC 3372 ADD_CONFIG_NAME("rpc"); 3373#endif 3374#ifdef HAVE_VERIFY 3375 ADD_CONFIG_NAME("verify"); 3376#endif 3377 Tcl_SetObjResult(interp, res); 3378 return (TCL_OK); 3379} 3380 3381/* 3382 * bdb_Handles -- 3383 * Implements the handles command. 3384 */ 3385static int 3386bdb_Handles(interp, objc, objv) 3387 Tcl_Interp *interp; /* Interpreter */ 3388 int objc; /* How many arguments? */ 3389 Tcl_Obj *CONST objv[]; /* The argument objects */ 3390{ 3391 DBTCL_INFO *p; 3392 Tcl_Obj *res, *handle; 3393 3394 /* 3395 * No args. Error if we have some 3396 */ 3397 if (objc != 2) { 3398 Tcl_WrongNumArgs(interp, 2, objv, ""); 3399 return (TCL_ERROR); 3400 } 3401 res = Tcl_NewListObj(0, NULL); 3402 3403 LIST_FOREACH(p, &__db_infohead, entries) { 3404 handle = NewStringObj(p->i_name, strlen(p->i_name)); 3405 if (Tcl_ListObjAppendElement(interp, res, handle) != TCL_OK) 3406 return (TCL_ERROR); 3407 } 3408 Tcl_SetObjResult(interp, res); 3409 return (TCL_OK); 3410} 3411 3412/* 3413 * bdb_MsgType - 3414 * Implements the msgtype command. 3415 * Given a replication message return its message type name. 3416 */ 3417static int 3418bdb_MsgType(interp, objc, objv) 3419 Tcl_Interp *interp; /* Interpreter */ 3420 int objc; /* How many arguments? */ 3421 Tcl_Obj *CONST objv[]; /* The argument objects */ 3422{ 3423 __rep_control_args *rp; 3424 Tcl_Obj *msgname; 3425 u_int32_t len, msgtype, swaptype; 3426 int freerp, ret; 3427 3428 /* 3429 * If the messages in rep.h change, this must change too! 3430 * Add "no_type" for 0 so that we directly index. 3431 */ 3432 static const char *msgnames[] = { 3433 "no_type", "alive", "alive_req", "all_req", 3434 "bulk_log", "bulk_page", 3435 "dupmaster", "file", "file_fail", "file_req", "lease_grant", 3436 "log", "log_more", "log_req", "master_req", "newclient", 3437 "newfile", "newmaster", "newsite", "page", 3438 "page_fail", "page_more", "page_req", 3439 "rerequest", "startsync", "update", "update_req", 3440 "verify", "verify_fail", "verify_req", 3441 "vote1", "vote2", NULL 3442 }; 3443 3444 /* 3445 * 1 arg, the message. Error if different. 3446 */ 3447 if (objc != 3) { 3448 Tcl_WrongNumArgs(interp, 3, objv, "msgtype msg"); 3449 return (TCL_ERROR); 3450 } 3451 3452 ret = _CopyObjBytes(interp, objv[2], &rp, &len, &freerp); 3453 if (ret != TCL_OK) { 3454 Tcl_SetResult(interp, 3455 "msgtype: bad control message", TCL_STATIC); 3456 return (TCL_ERROR); 3457 } 3458 swaptype = msgtype = rp->rectype; 3459 /* 3460 * We have no DB_ENV or ENV here. The message type may be 3461 * swapped. Get both and use the one that is in the message range. 3462 */ 3463 M_32_SWAP(swaptype); 3464 if (msgtype > REP_MAX_MSG && swaptype <= REP_MAX_MSG) 3465 msgtype = swaptype; 3466 msgname = NewStringObj(msgnames[msgtype], strlen(msgnames[msgtype])); 3467 Tcl_SetObjResult(interp, msgname); 3468 if (rp != NULL && freerp) 3469 __os_free(NULL, rp); 3470 return (TCL_OK); 3471} 3472 3473/* 3474 * bdb_DbUpgrade -- 3475 * Implements the DB->upgrade command. 3476 */ 3477static int 3478bdb_DbUpgrade(interp, objc, objv) 3479 Tcl_Interp *interp; /* Interpreter */ 3480 int objc; /* How many arguments? */ 3481 Tcl_Obj *CONST objv[]; /* The argument objects */ 3482{ 3483 static const char *bdbupg[] = { 3484 "-dupsort", "-env", "--", NULL 3485 }; 3486 enum bdbupg { 3487 TCL_DBUPG_DUPSORT, 3488 TCL_DBUPG_ENV, 3489 TCL_DBUPG_ENDARG 3490 }; 3491 DB_ENV *dbenv; 3492 DB *dbp; 3493 u_int32_t flags; 3494 int endarg, i, optindex, result, ret; 3495 char *arg, *db; 3496 3497 dbenv = NULL; 3498 dbp = NULL; 3499 result = TCL_OK; 3500 db = NULL; 3501 flags = endarg = 0; 3502 3503 if (objc < 2) { 3504 Tcl_WrongNumArgs(interp, 2, objv, "?args? filename"); 3505 return (TCL_ERROR); 3506 } 3507 3508 i = 2; 3509 while (i < objc) { 3510 if (Tcl_GetIndexFromObj(interp, objv[i], bdbupg, 3511 "option", TCL_EXACT, &optindex) != TCL_OK) { 3512 arg = Tcl_GetStringFromObj(objv[i], NULL); 3513 if (arg[0] == '-') { 3514 result = IS_HELP(objv[i]); 3515 goto error; 3516 } else 3517 Tcl_ResetResult(interp); 3518 break; 3519 } 3520 i++; 3521 switch ((enum bdbupg)optindex) { 3522 case TCL_DBUPG_DUPSORT: 3523 flags |= DB_DUPSORT; 3524 break; 3525 case TCL_DBUPG_ENV: 3526 arg = Tcl_GetStringFromObj(objv[i++], NULL); 3527 dbenv = NAME_TO_ENV(arg); 3528 if (dbenv == NULL) { 3529 Tcl_SetResult(interp, 3530 "db upgrade: illegal environment", 3531 TCL_STATIC); 3532 return (TCL_ERROR); 3533 } 3534 break; 3535 case TCL_DBUPG_ENDARG: 3536 endarg = 1; 3537 break; 3538 } 3539 /* 3540 * If, at any time, parsing the args we get an error, 3541 * bail out and return. 3542 */ 3543 if (result != TCL_OK) 3544 goto error; 3545 if (endarg) 3546 break; 3547 } 3548 if (result != TCL_OK) 3549 goto error; 3550 /* 3551 * The remaining arg is the db filename. 3552 */ 3553 if (i == (objc - 1)) 3554 db = Tcl_GetStringFromObj(objv[i++], NULL); 3555 else { 3556 Tcl_WrongNumArgs(interp, 2, objv, "?args? filename"); 3557 result = TCL_ERROR; 3558 goto error; 3559 } 3560 ret = db_create(&dbp, dbenv, 0); 3561 if (ret) { 3562 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 3563 "db_create"); 3564 goto error; 3565 } 3566 3567 /* 3568 * XXX 3569 * Remove restriction if error handling not tied to env. 3570 * 3571 * The DB->set_err* functions overwrite the environment. So, if 3572 * we are using an env, don't overwrite it; if not using an env, 3573 * then configure error handling. 3574 */ 3575 if (dbenv == NULL) { 3576 dbp->set_errpfx(dbp, "DbUpgrade"); 3577 dbp->set_errcall(dbp, _ErrorFunc); 3578 } 3579 ret = dbp->upgrade(dbp, db, flags); 3580 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db upgrade"); 3581error: 3582 if (dbp) 3583 (void)dbp->close(dbp, 0); 3584 return (result); 3585} 3586 3587/* 3588 * tcl_bt_compare and tcl_dup_compare -- 3589 * These two are basically identical internally, so may as well 3590 * share code. The only differences are the name used in error 3591 * reporting and the Tcl_Obj representing their respective procs. 3592 */ 3593static int 3594tcl_bt_compare(dbp, dbta, dbtb) 3595 DB *dbp; 3596 const DBT *dbta, *dbtb; 3597{ 3598 return (tcl_compare_callback(dbp, dbta, dbtb, 3599 ((DBTCL_INFO *)dbp->api_internal)->i_compare, "bt_compare")); 3600} 3601 3602static int 3603tcl_dup_compare(dbp, dbta, dbtb) 3604 DB *dbp; 3605 const DBT *dbta, *dbtb; 3606{ 3607 return (tcl_compare_callback(dbp, dbta, dbtb, 3608 ((DBTCL_INFO *)dbp->api_internal)->i_dupcompare, "dup_compare")); 3609} 3610 3611/* 3612 * tcl_compare_callback -- 3613 * Tcl callback for set_bt_compare and set_dup_compare. What this 3614 * function does is stuff the data fields of the two DBTs into Tcl ByteArray 3615 * objects, then call the procedure stored in ip->i_compare on the two 3616 * objects. Then we return that procedure's result as the comparison. 3617 */ 3618static int 3619tcl_compare_callback(dbp, dbta, dbtb, procobj, errname) 3620 DB *dbp; 3621 const DBT *dbta, *dbtb; 3622 Tcl_Obj *procobj; 3623 char *errname; 3624{ 3625 DBTCL_INFO *ip; 3626 Tcl_Interp *interp; 3627 Tcl_Obj *a, *b, *resobj, *objv[3]; 3628 int result, cmp; 3629 3630 ip = (DBTCL_INFO *)dbp->api_internal; 3631 interp = ip->i_interp; 3632 objv[0] = procobj; 3633 3634 /* 3635 * Create two ByteArray objects, with the two data we've been passed. 3636 * This will involve a copy, which is unpleasantly slow, but there's 3637 * little we can do to avoid this (I think). 3638 */ 3639 a = Tcl_NewByteArrayObj(dbta->data, (int)dbta->size); 3640 Tcl_IncrRefCount(a); 3641 b = Tcl_NewByteArrayObj(dbtb->data, (int)dbtb->size); 3642 Tcl_IncrRefCount(b); 3643 3644 objv[1] = a; 3645 objv[2] = b; 3646 3647 result = Tcl_EvalObjv(interp, 3, objv, 0); 3648 if (result != TCL_OK) { 3649 /* 3650 * XXX 3651 * If this or the next Tcl call fails, we're doomed. 3652 * There's no way to return an error from comparison functions, 3653 * no way to determine what the correct sort order is, and 3654 * so no way to avoid corrupting the database if we proceed. 3655 * We could play some games stashing return values on the 3656 * DB handle, but it's not worth the trouble--no one with 3657 * any sense is going to be using this other than for testing, 3658 * and failure typically means that the bt_compare proc 3659 * had a syntax error in it or something similarly dumb. 3660 * 3661 * So, drop core. If we're not running with diagnostic 3662 * mode, panic--and always return a negative number. :-) 3663 */ 3664panic: __db_errx(dbp->env, "Tcl %s callback failed", errname); 3665 return (__env_panic(dbp->env, DB_RUNRECOVERY)); 3666 } 3667 3668 resobj = Tcl_GetObjResult(interp); 3669 result = Tcl_GetIntFromObj(interp, resobj, &cmp); 3670 if (result != TCL_OK) 3671 goto panic; 3672 3673 Tcl_DecrRefCount(a); 3674 Tcl_DecrRefCount(b); 3675 return (cmp); 3676} 3677 3678/* 3679 * tcl_h_hash -- 3680 * Tcl callback for the hashing function. See tcl_compare_callback-- 3681 * this works much the same way, only we're given a buffer and a length 3682 * instead of two DBTs. 3683 */ 3684static u_int32_t 3685tcl_h_hash(dbp, buf, len) 3686 DB *dbp; 3687 const void *buf; 3688 u_int32_t len; 3689{ 3690 DBTCL_INFO *ip; 3691 Tcl_Interp *interp; 3692 Tcl_Obj *objv[2]; 3693 int result, hval; 3694 3695 ip = (DBTCL_INFO *)dbp->api_internal; 3696 interp = ip->i_interp; 3697 objv[0] = ip->i_hashproc; 3698 3699 /* 3700 * Create a ByteArray for the buffer. 3701 */ 3702 objv[1] = Tcl_NewByteArrayObj((void *)buf, (int)len); 3703 Tcl_IncrRefCount(objv[1]); 3704 result = Tcl_EvalObjv(interp, 2, objv, 0); 3705 if (result != TCL_OK) 3706 goto panic; 3707 3708 result = Tcl_GetIntFromObj(interp, Tcl_GetObjResult(interp), &hval); 3709 if (result != TCL_OK) 3710 goto panic; 3711 3712 Tcl_DecrRefCount(objv[1]); 3713 return ((u_int32_t)hval); 3714 3715panic: __db_errx(dbp->env, "Tcl h_hash callback failed"); 3716 3717 (void)__env_panic(dbp->env, DB_RUNRECOVERY); 3718 return (0); 3719} 3720 3721/* 3722 * tcl_rep_send -- 3723 * Replication send callback. 3724 * 3725 * PUBLIC: int tcl_rep_send __P((DB_ENV *, 3726 * PUBLIC: const DBT *, const DBT *, const DB_LSN *, int, u_int32_t)); 3727 */ 3728int 3729tcl_rep_send(dbenv, control, rec, lsnp, eid, flags) 3730 DB_ENV *dbenv; 3731 const DBT *control, *rec; 3732 const DB_LSN *lsnp; 3733 int eid; 3734 u_int32_t flags; 3735{ 3736#define TCLDB_SENDITEMS 7 3737#define TCLDB_MAXREPFLAGS 32 3738 DBTCL_INFO *ip; 3739 Tcl_Interp *interp; 3740 Tcl_Obj *control_o, *eid_o, *flags_o, *lsn_o, *origobj, *rec_o; 3741 Tcl_Obj *lsnobj[2], *myobjv[TCLDB_MAXREPFLAGS], *objv[TCLDB_SENDITEMS]; 3742 Tcl_Obj *resobj; 3743 int i, myobjc, result, ret; 3744 3745 ip = (DBTCL_INFO *)dbenv->app_private; 3746 interp = ip->i_interp; 3747 objv[0] = ip->i_rep_send; 3748 3749 control_o = Tcl_NewByteArrayObj(control->data, (int)control->size); 3750 Tcl_IncrRefCount(control_o); 3751 3752 rec_o = Tcl_NewByteArrayObj(rec->data, (int)rec->size); 3753 Tcl_IncrRefCount(rec_o); 3754 3755 eid_o = Tcl_NewIntObj(eid); 3756 Tcl_IncrRefCount(eid_o); 3757 3758 myobjv[myobjc = 0] = NULL; 3759 if (flags == 0) 3760 myobjv[myobjc++] = NewStringObj("none", strlen("none")); 3761 if (LF_ISSET(DB_REP_ANYWHERE)) 3762 myobjv[myobjc++] = NewStringObj("any", strlen("any")); 3763 if (LF_ISSET(DB_REP_NOBUFFER)) 3764 myobjv[myobjc++] = NewStringObj("nobuffer", strlen("nobuffer")); 3765 if (LF_ISSET(DB_REP_PERMANENT)) 3766 myobjv[myobjc++] = NewStringObj("perm", strlen("perm")); 3767 if (LF_ISSET(DB_REP_REREQUEST)) 3768 myobjv[myobjc++] = 3769 NewStringObj("rerequest", strlen("rerequest")); 3770 /* 3771 * If we're given an unrecognized flag send "unknown". 3772 */ 3773 if (myobjc == 0) 3774 myobjv[myobjc++] = NewStringObj("unknown", strlen("unknown")); 3775 for (i = 0; i < myobjc; i++) 3776 Tcl_IncrRefCount(myobjv[i]); 3777 flags_o = Tcl_NewListObj(myobjc, myobjv); 3778 Tcl_IncrRefCount(flags_o); 3779 3780 lsnobj[0] = Tcl_NewLongObj((long)lsnp->file); 3781 Tcl_IncrRefCount(lsnobj[0]); 3782 lsnobj[1] = Tcl_NewLongObj((long)lsnp->offset); 3783 Tcl_IncrRefCount(lsnobj[1]); 3784 lsn_o = Tcl_NewListObj(2, lsnobj); 3785 Tcl_IncrRefCount(lsn_o); 3786 3787 objv[1] = control_o; 3788 objv[2] = rec_o; 3789 objv[3] = ip->i_rep_eid; /* From ID */ 3790 objv[4] = eid_o; /* To ID */ 3791 objv[5] = flags_o; /* Flags */ 3792 objv[6] = lsn_o; /* LSN */ 3793 3794 /* 3795 * We really want to return the original result to the 3796 * user. So, save the result obj here, and then after 3797 * we've taken care of the Tcl_EvalObjv, set the result 3798 * back to this original result. 3799 */ 3800 origobj = Tcl_GetObjResult(interp); 3801 Tcl_IncrRefCount(origobj); 3802 result = Tcl_EvalObjv(interp, TCLDB_SENDITEMS, objv, 0); 3803 if (result != TCL_OK) { 3804 /* 3805 * XXX 3806 * This probably isn't the right error behavior, but 3807 * this error should only happen if the Tcl callback is 3808 * somehow invalid, which is a fatal scripting bug. 3809 */ 3810err: __db_errx(dbenv->env, 3811 "Tcl rep_send failure: %s", Tcl_GetStringResult(interp)); 3812 return (EINVAL); 3813 } 3814 3815 resobj = Tcl_GetObjResult(interp); 3816 result = Tcl_GetIntFromObj(interp, resobj, &ret); 3817 if (result != TCL_OK) 3818 goto err; 3819 3820 Tcl_SetObjResult(interp, origobj); 3821 Tcl_DecrRefCount(origobj); 3822 Tcl_DecrRefCount(control_o); 3823 Tcl_DecrRefCount(rec_o); 3824 Tcl_DecrRefCount(eid_o); 3825 for (i = 0; i < myobjc; i++) 3826 Tcl_DecrRefCount(myobjv[i]); 3827 Tcl_DecrRefCount(flags_o); 3828 Tcl_DecrRefCount(lsnobj[0]); 3829 Tcl_DecrRefCount(lsnobj[1]); 3830 Tcl_DecrRefCount(lsn_o); 3831 3832 return (ret); 3833} 3834#endif 3835 3836#ifdef CONFIG_TEST 3837/* 3838 * tcl_db_malloc, tcl_db_realloc, tcl_db_free -- 3839 * Tcl-local malloc, realloc, and free functions to use for user data 3840 * to exercise umalloc/urealloc/ufree. Allocate the memory as a Tcl object 3841 * so we're sure to exacerbate and catch any shared-library issues. 3842 */ 3843static void * 3844tcl_db_malloc(size) 3845 size_t size; 3846{ 3847 Tcl_Obj *obj; 3848 void *buf; 3849 3850 obj = Tcl_NewObj(); 3851 if (obj == NULL) 3852 return (NULL); 3853 Tcl_IncrRefCount(obj); 3854 3855 Tcl_SetObjLength(obj, (int)(size + sizeof(Tcl_Obj *))); 3856 buf = Tcl_GetString(obj); 3857 memcpy(buf, &obj, sizeof(&obj)); 3858 3859 buf = (Tcl_Obj **)buf + 1; 3860 return (buf); 3861} 3862 3863static void * 3864tcl_db_realloc(ptr, size) 3865 void *ptr; 3866 size_t size; 3867{ 3868 Tcl_Obj *obj; 3869 3870 if (ptr == NULL) 3871 return (tcl_db_malloc(size)); 3872 3873 obj = *(Tcl_Obj **)((Tcl_Obj **)ptr - 1); 3874 Tcl_SetObjLength(obj, (int)(size + sizeof(Tcl_Obj *))); 3875 3876 ptr = Tcl_GetString(obj); 3877 memcpy(ptr, &obj, sizeof(&obj)); 3878 3879 ptr = (Tcl_Obj **)ptr + 1; 3880 return (ptr); 3881} 3882 3883static void 3884tcl_db_free(ptr) 3885 void *ptr; 3886{ 3887 Tcl_Obj *obj; 3888 3889 obj = *(Tcl_Obj **)((Tcl_Obj **)ptr - 1); 3890 Tcl_DecrRefCount(obj); 3891} 3892#endif 3893