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