00001
00002
00003
00004
00005
00006
00007
00008
00009
00010 #include "db_config.h"
00011
00012 #ifndef NO_SYSTEM_INCLUDES
00013 #include <sys/types.h>
00014
00015 #include <stdlib.h>
00016 #include <string.h>
00017 #include <tcl.h>
00018 #endif
00019
00020 #ifdef CONFIG_TEST
00021 #define DB_DBM_HSEARCH 1
00022 #endif
00023
00024 #include "db_int.h"
00025 #include "dbinc/db_page.h"
00026 #include "dbinc/hash.h"
00027 #include "dbinc/tcl_db.h"
00028
00029
00030 DBTCL_GLOBAL __dbtcl_global;
00031
00032
00033
00034
00035 static int berkdb_Cmd __P((ClientData, Tcl_Interp *, int,
00036 Tcl_Obj * CONST*));
00037 static int bdb_EnvOpen __P((Tcl_Interp *, int, Tcl_Obj * CONST*,
00038 DBTCL_INFO *, DB_ENV **));
00039 static int bdb_DbOpen __P((Tcl_Interp *, int, Tcl_Obj * CONST*,
00040 DBTCL_INFO *, DB **));
00041 static int bdb_DbRemove __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
00042 static int bdb_DbRename __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
00043 static int bdb_Version __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
00044
00045 #ifdef HAVE_SEQUENCE
00046 static int bdb_SeqOpen __P((Tcl_Interp *, int, Tcl_Obj * CONST*,
00047 DBTCL_INFO *, DB_SEQUENCE **));
00048 #endif
00049
00050 #ifdef CONFIG_TEST
00051 static int bdb_DbUpgrade __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
00052 static int bdb_DbVerify __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
00053 static int bdb_Handles __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
00054 static int bdb_MsgType __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
00055
00056 static int tcl_bt_compare __P((DB *, const DBT *, const DBT *));
00057 static int tcl_compare_callback __P((DB *, const DBT *, const DBT *,
00058 Tcl_Obj *, char *));
00059 static void tcl_db_free __P((void *));
00060 static void * tcl_db_malloc __P((size_t));
00061 static void * tcl_db_realloc __P((void *, size_t));
00062 static int tcl_dup_compare __P((DB *, const DBT *, const DBT *));
00063 static u_int32_t tcl_h_hash __P((DB *, const void *, u_int32_t));
00064 #endif
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074 int
00075 Db_tcl_Init(interp)
00076 Tcl_Interp *interp;
00077
00078 {
00079 int code;
00080 char pkg[12];
00081
00082 snprintf(pkg, sizeof(pkg), "%d.%d", DB_VERSION_MAJOR, DB_VERSION_MINOR);
00083 code = Tcl_PkgProvide(interp, "Db_tcl", pkg);
00084 if (code != TCL_OK)
00085 return (code);
00086
00087 (void)Tcl_CreateObjCommand(interp,
00088 "berkdb", (Tcl_ObjCmdProc *)berkdb_Cmd, (ClientData)0, NULL);
00089
00090
00091
00092 (void)Tcl_LinkVar(
00093 interp, "__debug_on", (char *)&__debug_on, TCL_LINK_INT);
00094 (void)Tcl_LinkVar(
00095 interp, "__debug_print", (char *)&__debug_print, TCL_LINK_INT);
00096 (void)Tcl_LinkVar(
00097 interp, "__debug_stop", (char *)&__debug_stop, TCL_LINK_INT);
00098 (void)Tcl_LinkVar(
00099 interp, "__debug_test", (char *)&__debug_test,
00100 TCL_LINK_INT);
00101 LIST_INIT(&__db_infohead);
00102 return (TCL_OK);
00103 }
00104
00105
00106
00107
00108
00109
00110
00111
00112
00113
00114
00115
00116
00117
00118 static int
00119 berkdb_Cmd(notused, interp, objc, objv)
00120 ClientData notused;
00121 Tcl_Interp *interp;
00122 int objc;
00123 Tcl_Obj *CONST objv[];
00124 {
00125 static const char *berkdbcmds[] = {
00126 #ifdef CONFIG_TEST
00127 "dbverify",
00128 "handles",
00129 "msgtype",
00130 "upgrade",
00131 #endif
00132 "dbremove",
00133 "dbrename",
00134 "env",
00135 "envremove",
00136 "open",
00137 #ifdef HAVE_SEQUENCE
00138 "sequence",
00139 #endif
00140 "version",
00141 #ifdef CONFIG_TEST
00142
00143 "hcreate", "hsearch", "hdestroy",
00144 "dbminit", "fetch", "store",
00145 "delete", "firstkey", "nextkey",
00146 "ndbm_open", "dbmclose",
00147 #endif
00148
00149 "rand", "random_int", "srand",
00150 "debug_check",
00151 NULL
00152 };
00153
00154
00155
00156 enum berkdbcmds {
00157 #ifdef CONFIG_TEST
00158 BDB_DBVERIFY,
00159 BDB_HANDLES,
00160 BDB_MSGTYPE,
00161 BDB_UPGRADE,
00162 #endif
00163 BDB_DBREMOVE,
00164 BDB_DBRENAME,
00165 BDB_ENV,
00166 BDB_ENVREMOVE,
00167 BDB_OPEN,
00168 #ifdef HAVE_SEQUENCE
00169 BDB_SEQUENCE,
00170 #endif
00171 BDB_VERSION,
00172 #ifdef CONFIG_TEST
00173 BDB_HCREATEX, BDB_HSEARCHX, BDB_HDESTROYX,
00174 BDB_DBMINITX, BDB_FETCHX, BDB_STOREX,
00175 BDB_DELETEX, BDB_FIRSTKEYX, BDB_NEXTKEYX,
00176 BDB_NDBMOPENX, BDB_DBMCLOSEX,
00177 #endif
00178 BDB_RANDX, BDB_RAND_INTX, BDB_SRANDX,
00179 BDB_DBGCKX
00180 };
00181 static int env_id = 0;
00182 static int db_id = 0;
00183 #ifdef HAVE_SEQUENCE
00184 static int seq_id = 0;
00185 #endif
00186
00187 DB *dbp;
00188 #ifdef HAVE_SEQUENCE
00189 DB_SEQUENCE *seq;
00190 #endif
00191 #ifdef CONFIG_TEST
00192 DBM *ndbmp;
00193 static int ndbm_id = 0;
00194 #endif
00195 DBTCL_INFO *ip;
00196 DB_ENV *envp;
00197 Tcl_Obj *res;
00198 int cmdindex, result;
00199 char newname[MSG_SIZE];
00200
00201 COMPQUIET(notused, NULL);
00202
00203 Tcl_ResetResult(interp);
00204 memset(newname, 0, MSG_SIZE);
00205 result = TCL_OK;
00206 if (objc <= 1) {
00207 Tcl_WrongNumArgs(interp, 1, objv, "command cmdargs");
00208 return (TCL_ERROR);
00209 }
00210
00211
00212
00213
00214
00215 if (Tcl_GetIndexFromObj(interp,
00216 objv[1], berkdbcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
00217 return (IS_HELP(objv[1]));
00218 res = NULL;
00219 switch ((enum berkdbcmds)cmdindex) {
00220 #ifdef CONFIG_TEST
00221 case BDB_DBVERIFY:
00222 result = bdb_DbVerify(interp, objc, objv);
00223 break;
00224 case BDB_HANDLES:
00225 result = bdb_Handles(interp, objc, objv);
00226 break;
00227 case BDB_MSGTYPE:
00228 result = bdb_MsgType(interp, objc, objv);
00229 break;
00230 case BDB_UPGRADE:
00231 result = bdb_DbUpgrade(interp, objc, objv);
00232 break;
00233 #endif
00234 case BDB_VERSION:
00235 _debug_check();
00236 result = bdb_Version(interp, objc, objv);
00237 break;
00238 case BDB_ENV:
00239 snprintf(newname, sizeof(newname), "env%d", env_id);
00240 ip = _NewInfo(interp, NULL, newname, I_ENV);
00241 if (ip != NULL) {
00242 result = bdb_EnvOpen(interp, objc, objv, ip, &envp);
00243 if (result == TCL_OK && envp != NULL) {
00244 env_id++;
00245 (void)Tcl_CreateObjCommand(interp, newname,
00246 (Tcl_ObjCmdProc *)env_Cmd,
00247 (ClientData)envp, NULL);
00248
00249 res = NewStringObj(newname, strlen(newname));
00250 _SetInfoData(ip, envp);
00251 } else
00252 _DeleteInfo(ip);
00253 } else {
00254 Tcl_SetResult(interp, "Could not set up info",
00255 TCL_STATIC);
00256 result = TCL_ERROR;
00257 }
00258 break;
00259 case BDB_DBREMOVE:
00260 result = bdb_DbRemove(interp, objc, objv);
00261 break;
00262 case BDB_DBRENAME:
00263 result = bdb_DbRename(interp, objc, objv);
00264 break;
00265 case BDB_ENVREMOVE:
00266 result = tcl_EnvRemove(interp, objc, objv, NULL, NULL);
00267 break;
00268 case BDB_OPEN:
00269 snprintf(newname, sizeof(newname), "db%d", db_id);
00270 ip = _NewInfo(interp, NULL, newname, I_DB);
00271 if (ip != NULL) {
00272 result = bdb_DbOpen(interp, objc, objv, ip, &dbp);
00273 if (result == TCL_OK && dbp != NULL) {
00274 db_id++;
00275 (void)Tcl_CreateObjCommand(interp, newname,
00276 (Tcl_ObjCmdProc *)db_Cmd,
00277 (ClientData)dbp, NULL);
00278
00279 res = NewStringObj(newname, strlen(newname));
00280 _SetInfoData(ip, dbp);
00281 } else
00282 _DeleteInfo(ip);
00283 } else {
00284 Tcl_SetResult(interp, "Could not set up info",
00285 TCL_STATIC);
00286 result = TCL_ERROR;
00287 }
00288 break;
00289 #ifdef HAVE_SEQUENCE
00290 case BDB_SEQUENCE:
00291 snprintf(newname, sizeof(newname), "seq%d", seq_id);
00292 ip = _NewInfo(interp, NULL, newname, I_SEQ);
00293 if (ip != NULL) {
00294 result = bdb_SeqOpen(interp, objc, objv, ip, &seq);
00295 if (result == TCL_OK && seq != NULL) {
00296 seq_id++;
00297 (void)Tcl_CreateObjCommand(interp, newname,
00298 (Tcl_ObjCmdProc *)seq_Cmd,
00299 (ClientData)seq, NULL);
00300
00301 res = NewStringObj(newname, strlen(newname));
00302 _SetInfoData(ip, seq);
00303 } else
00304 _DeleteInfo(ip);
00305 } else {
00306 Tcl_SetResult(interp, "Could not set up info",
00307 TCL_STATIC);
00308 result = TCL_ERROR;
00309 }
00310 break;
00311 #endif
00312 #ifdef CONFIG_TEST
00313 case BDB_HCREATEX:
00314 case BDB_HSEARCHX:
00315 case BDB_HDESTROYX:
00316 result = bdb_HCommand(interp, objc, objv);
00317 break;
00318 case BDB_DBMINITX:
00319 case BDB_DBMCLOSEX:
00320 case BDB_FETCHX:
00321 case BDB_STOREX:
00322 case BDB_DELETEX:
00323 case BDB_FIRSTKEYX:
00324 case BDB_NEXTKEYX:
00325 result = bdb_DbmCommand(interp, objc, objv, DBTCL_DBM, NULL);
00326 break;
00327 case BDB_NDBMOPENX:
00328 snprintf(newname, sizeof(newname), "ndbm%d", ndbm_id);
00329 ip = _NewInfo(interp, NULL, newname, I_NDBM);
00330 if (ip != NULL) {
00331 result = bdb_NdbmOpen(interp, objc, objv, &ndbmp);
00332 if (result == TCL_OK) {
00333 ndbm_id++;
00334 (void)Tcl_CreateObjCommand(interp, newname,
00335 (Tcl_ObjCmdProc *)ndbm_Cmd,
00336 (ClientData)ndbmp, NULL);
00337
00338 res = NewStringObj(newname, strlen(newname));
00339 _SetInfoData(ip, ndbmp);
00340 } else
00341 _DeleteInfo(ip);
00342 } else {
00343 Tcl_SetResult(interp, "Could not set up info",
00344 TCL_STATIC);
00345 result = TCL_ERROR;
00346 }
00347 break;
00348 #endif
00349 case BDB_RANDX:
00350 case BDB_RAND_INTX:
00351 case BDB_SRANDX:
00352 result = bdb_RandCommand(interp, objc, objv);
00353 break;
00354 case BDB_DBGCKX:
00355 _debug_check();
00356 res = Tcl_NewIntObj(0);
00357 break;
00358 }
00359
00360
00361
00362
00363 if (result == TCL_OK && res != NULL)
00364 Tcl_SetObjResult(interp, res);
00365 return (result);
00366 }
00367
00368
00369
00370
00371
00372
00373
00374
00375
00376
00377
00378
00379
00380 static int
00381 bdb_EnvOpen(interp, objc, objv, ip, env)
00382 Tcl_Interp *interp;
00383 int objc;
00384 Tcl_Obj *CONST objv[];
00385 DBTCL_INFO *ip;
00386 DB_ENV **env;
00387 {
00388 static const char *envopen[] = {
00389 #ifdef CONFIG_TEST
00390 "-alloc",
00391 "-auto_commit",
00392 "-cdb",
00393 "-cdb_alldb",
00394 "-client_timeout",
00395 "-lock",
00396 "-lock_conflict",
00397 "-lock_detect",
00398 "-lock_max",
00399 "-lock_max_locks",
00400 "-lock_max_lockers",
00401 "-lock_max_objects",
00402 "-lock_timeout",
00403 "-log",
00404 "-log_filemode",
00405 "-log_buffer",
00406 "-log_inmemory",
00407 "-log_max",
00408 "-log_regionmax",
00409 "-log_remove",
00410 "-mpool_max_openfd",
00411 "-mpool_max_write",
00412 "-mpool_mmap_size",
00413 "-mpool_nommap",
00414 "-overwrite",
00415 "-region_init",
00416 "-rep",
00417 "-rep_client",
00418 "-rep_master",
00419 "-rep_transport",
00420 "-server",
00421 "-server_timeout",
00422 "-set_intermediate_dir",
00423 "-thread",
00424 "-time_notgranted",
00425 "-txn_timeout",
00426 "-txn_timestamp",
00427 "-verbose",
00428 "-wrnosync",
00429 #endif
00430 "-cachesize",
00431 "-create",
00432 "-data_dir",
00433 "-encryptaes",
00434 "-encryptany",
00435 "-errfile",
00436 "-errpfx",
00437 "-home",
00438 "-log_dir",
00439 "-mode",
00440 "-private",
00441 "-recover",
00442 "-recover_fatal",
00443 "-register",
00444 "-shm_key",
00445 "-system_mem",
00446 "-tmp_dir",
00447 "-txn",
00448 "-txn_max",
00449 "-use_environ",
00450 "-use_environ_root",
00451 NULL
00452 };
00453
00454
00455
00456
00457
00458 enum envopen {
00459 #ifdef CONFIG_TEST
00460 ENV_ALLOC,
00461 ENV_AUTO_COMMIT,
00462 ENV_CDB,
00463 ENV_CDB_ALLDB,
00464 ENV_CLIENT_TO,
00465 ENV_LOCK,
00466 ENV_CONFLICT,
00467 ENV_DETECT,
00468 ENV_LOCK_MAX,
00469 ENV_LOCK_MAX_LOCKS,
00470 ENV_LOCK_MAX_LOCKERS,
00471 ENV_LOCK_MAX_OBJECTS,
00472 ENV_LOCK_TIMEOUT,
00473 ENV_LOG,
00474 ENV_LOG_FILEMODE,
00475 ENV_LOG_BUFFER,
00476 ENV_LOG_INMEMORY,
00477 ENV_LOG_MAX,
00478 ENV_LOG_REGIONMAX,
00479 ENV_LOG_REMOVE,
00480 ENV_MPOOL_MAX_OPENFD,
00481 ENV_MPOOL_MAX_WRITE,
00482 ENV_MPOOL_MMAP_SIZE,
00483 ENV_MPOOL_NOMMAP,
00484 ENV_OVERWRITE,
00485 ENV_REGION_INIT,
00486 ENV_REP,
00487 ENV_REP_CLIENT,
00488 ENV_REP_MASTER,
00489 ENV_REP_TRANSPORT,
00490 ENV_SERVER,
00491 ENV_SERVER_TO,
00492 ENV_SET_INTERMEDIATE_DIR,
00493 ENV_THREAD,
00494 ENV_TIME_NOTGRANTED,
00495 ENV_TXN_TIMEOUT,
00496 ENV_TXN_TIME,
00497 ENV_VERBOSE,
00498 ENV_WRNOSYNC,
00499 #endif
00500 ENV_CACHESIZE,
00501 ENV_CREATE,
00502 ENV_DATA_DIR,
00503 ENV_ENCRYPT_AES,
00504 ENV_ENCRYPT_ANY,
00505 ENV_ERRFILE,
00506 ENV_ERRPFX,
00507 ENV_HOME,
00508 ENV_LOG_DIR,
00509 ENV_MODE,
00510 ENV_PRIVATE,
00511 ENV_RECOVER,
00512 ENV_RECOVER_FATAL,
00513 ENV_REGISTER,
00514 ENV_SHM_KEY,
00515 ENV_SYSTEM_MEM,
00516 ENV_TMP_DIR,
00517 ENV_TXN,
00518 ENV_TXN_MAX,
00519 ENV_USE_ENVIRON,
00520 ENV_USE_ENVIRON_ROOT
00521 };
00522 Tcl_Obj **myobjv;
00523 u_int32_t cr_flags, gbytes, bytes, logbufset, logmaxset;
00524 u_int32_t open_flags, rep_flags, set_flags, uintarg;
00525 int i, mode, myobjc, ncaches, optindex, result, ret;
00526 long client_to, server_to, shm;
00527 char *arg, *home, *passwd, *server;
00528 #ifdef CONFIG_TEST
00529 Tcl_Obj **myobjv1;
00530 time_t timestamp;
00531 long v;
00532 u_int32_t detect;
00533 u_int8_t *conflicts;
00534 int intarg, intarg2, j, nmodes, temp;
00535 #endif
00536
00537 result = TCL_OK;
00538 mode = 0;
00539 rep_flags = set_flags = cr_flags = 0;
00540 home = NULL;
00541
00542
00543
00544
00545
00546
00547
00548
00549
00550
00551
00552
00553
00554
00555 open_flags = 0;
00556 logmaxset = logbufset = 0;
00557
00558 if (objc <= 2) {
00559 Tcl_WrongNumArgs(interp, 2, objv, "?args?");
00560 return (TCL_ERROR);
00561 }
00562
00563
00564
00565
00566 server = NULL;
00567 server_to = client_to = 0;
00568 i = 2;
00569 while (i < objc) {
00570 if (Tcl_GetIndexFromObj(interp, objv[i++], envopen, "option",
00571 TCL_EXACT, &optindex) != TCL_OK) {
00572 Tcl_ResetResult(interp);
00573 continue;
00574 }
00575 #ifdef CONFIG_TEST
00576 switch ((enum envopen)optindex) {
00577 case ENV_SERVER:
00578 if (i >= objc) {
00579 Tcl_WrongNumArgs(interp, 2, objv,
00580 "?-server hostname");
00581 result = TCL_ERROR;
00582 break;
00583 }
00584 FLD_SET(cr_flags, DB_RPCCLIENT);
00585 server = Tcl_GetStringFromObj(objv[i++], NULL);
00586 break;
00587 case ENV_SERVER_TO:
00588 if (i >= objc) {
00589 Tcl_WrongNumArgs(interp, 2, objv,
00590 "?-server_to secs");
00591 result = TCL_ERROR;
00592 break;
00593 }
00594 FLD_SET(cr_flags, DB_RPCCLIENT);
00595 result = Tcl_GetLongFromObj(interp, objv[i++],
00596 &server_to);
00597 break;
00598 case ENV_CLIENT_TO:
00599 if (i >= objc) {
00600 Tcl_WrongNumArgs(interp, 2, objv,
00601 "?-client_to secs");
00602 result = TCL_ERROR;
00603 break;
00604 }
00605 FLD_SET(cr_flags, DB_RPCCLIENT);
00606 result = Tcl_GetLongFromObj(interp, objv[i++],
00607 &client_to);
00608 break;
00609 default:
00610 break;
00611 }
00612 #endif
00613 }
00614 if (result != TCL_OK)
00615 return (TCL_ERROR);
00616 ret = db_env_create(env, cr_flags);
00617 if (ret)
00618 return (_ReturnSetup(interp, ret, DB_RETOK_STD(ret),
00619 "db_env_create"));
00620
00621
00622
00623
00624 if (server != NULL) {
00625 (*env)->set_errpfx((*env), ip->i_name);
00626 (*env)->set_errcall((*env), _ErrorFunc);
00627 if ((ret = (*env)->set_rpc_server((*env), NULL, server,
00628 client_to, server_to, 0)) != 0) {
00629 result = TCL_ERROR;
00630 goto error;
00631 }
00632 } else {
00633
00634
00635
00636
00637 (*env)->set_errpfx((*env), ip->i_name);
00638 (*env)->set_errcall((*env), _ErrorFunc);
00639 }
00640
00641
00642 (*env)->app_private = ip;
00643
00644
00645
00646
00647
00648 i = 2;
00649 while (i < objc) {
00650 Tcl_ResetResult(interp);
00651 if (Tcl_GetIndexFromObj(interp, objv[i], envopen, "option",
00652 TCL_EXACT, &optindex) != TCL_OK) {
00653 result = IS_HELP(objv[i]);
00654 goto error;
00655 }
00656 i++;
00657 switch ((enum envopen)optindex) {
00658 #ifdef CONFIG_TEST
00659 case ENV_SERVER:
00660 case ENV_SERVER_TO:
00661 case ENV_CLIENT_TO:
00662
00663
00664
00665 i++;
00666 break;
00667 case ENV_ALLOC:
00668
00669
00670
00671
00672
00673 (void)(*env)->set_alloc(*env,
00674 tcl_db_malloc, tcl_db_realloc, tcl_db_free);
00675 break;
00676 case ENV_AUTO_COMMIT:
00677 FLD_SET(set_flags, DB_AUTO_COMMIT);
00678 break;
00679 case ENV_CDB:
00680 FLD_SET(open_flags, DB_INIT_CDB | DB_INIT_MPOOL);
00681 break;
00682 case ENV_CDB_ALLDB:
00683 FLD_SET(set_flags, DB_CDB_ALLDB);
00684 break;
00685 case ENV_LOCK:
00686 FLD_SET(open_flags, DB_INIT_LOCK | DB_INIT_MPOOL);
00687 break;
00688 case ENV_CONFLICT:
00689
00690
00691
00692
00693
00694
00695
00696 result = Tcl_ListObjGetElements(interp, objv[i],
00697 &myobjc, &myobjv);
00698 if (result == TCL_OK)
00699 i++;
00700 else
00701 break;
00702 if (myobjc != 2) {
00703 Tcl_WrongNumArgs(interp, 2, objv,
00704 "?-lock_conflict {nmodes {matrix}}?");
00705 result = TCL_ERROR;
00706 break;
00707 }
00708 result = Tcl_GetIntFromObj(interp, myobjv[0], &nmodes);
00709 if (result != TCL_OK)
00710 break;
00711 result = Tcl_ListObjGetElements(interp, myobjv[1],
00712 &myobjc, &myobjv1);
00713 if (myobjc != (nmodes * nmodes)) {
00714 Tcl_WrongNumArgs(interp, 2, objv,
00715 "?-lock_conflict {nmodes {matrix}}?");
00716 result = TCL_ERROR;
00717 break;
00718 }
00719
00720 ret = __os_malloc(*env, sizeof(u_int8_t) *
00721 (size_t)nmodes * (size_t)nmodes, &conflicts);
00722 if (ret != 0) {
00723 result = TCL_ERROR;
00724 break;
00725 }
00726 for (j = 0; j < myobjc; j++) {
00727 result = Tcl_GetIntFromObj(interp, myobjv1[j],
00728 &temp);
00729 conflicts[j] = temp;
00730 if (result != TCL_OK) {
00731 __os_free(NULL, conflicts);
00732 break;
00733 }
00734 }
00735 _debug_check();
00736 ret = (*env)->set_lk_conflicts(*env,
00737 (u_int8_t *)conflicts, nmodes);
00738 __os_free(NULL, conflicts);
00739 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
00740 "set_lk_conflicts");
00741 break;
00742 case ENV_DETECT:
00743 if (i >= objc) {
00744 Tcl_WrongNumArgs(interp, 2, objv,
00745 "?-lock_detect policy?");
00746 result = TCL_ERROR;
00747 break;
00748 }
00749 arg = Tcl_GetStringFromObj(objv[i++], NULL);
00750 if (strcmp(arg, "default") == 0)
00751 detect = DB_LOCK_DEFAULT;
00752 else if (strcmp(arg, "expire") == 0)
00753 detect = DB_LOCK_EXPIRE;
00754 else if (strcmp(arg, "maxlocks") == 0)
00755 detect = DB_LOCK_MAXLOCKS;
00756 else if (strcmp(arg, "maxwrites") == 0)
00757 detect = DB_LOCK_MAXWRITE;
00758 else if (strcmp(arg, "minlocks") == 0)
00759 detect = DB_LOCK_MINLOCKS;
00760 else if (strcmp(arg, "minwrites") == 0)
00761 detect = DB_LOCK_MINWRITE;
00762 else if (strcmp(arg, "oldest") == 0)
00763 detect = DB_LOCK_OLDEST;
00764 else if (strcmp(arg, "youngest") == 0)
00765 detect = DB_LOCK_YOUNGEST;
00766 else if (strcmp(arg, "random") == 0)
00767 detect = DB_LOCK_RANDOM;
00768 else {
00769 Tcl_AddErrorInfo(interp,
00770 "lock_detect: illegal policy");
00771 result = TCL_ERROR;
00772 break;
00773 }
00774 _debug_check();
00775 ret = (*env)->set_lk_detect(*env, detect);
00776 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
00777 "lock_detect");
00778 break;
00779 case ENV_LOCK_MAX:
00780 case ENV_LOCK_MAX_LOCKS:
00781 case ENV_LOCK_MAX_LOCKERS:
00782 case ENV_LOCK_MAX_OBJECTS:
00783 if (i >= objc) {
00784 Tcl_WrongNumArgs(interp, 2, objv,
00785 "?-lock_max max?");
00786 result = TCL_ERROR;
00787 break;
00788 }
00789 result = _GetUInt32(interp, objv[i++], &uintarg);
00790 if (result == TCL_OK) {
00791 _debug_check();
00792 switch ((enum envopen)optindex) {
00793 case ENV_LOCK_MAX:
00794 ret = (*env)->set_lk_max(*env,
00795 uintarg);
00796 break;
00797 case ENV_LOCK_MAX_LOCKS:
00798 ret = (*env)->set_lk_max_locks(*env,
00799 uintarg);
00800 break;
00801 case ENV_LOCK_MAX_LOCKERS:
00802 ret = (*env)->set_lk_max_lockers(*env,
00803 uintarg);
00804 break;
00805 case ENV_LOCK_MAX_OBJECTS:
00806 ret = (*env)->set_lk_max_objects(*env,
00807 uintarg);
00808 break;
00809 default:
00810 break;
00811 }
00812 result = _ReturnSetup(interp, ret,
00813 DB_RETOK_STD(ret), "lock_max");
00814 }
00815 break;
00816 case ENV_TXN_TIME:
00817 case ENV_TXN_TIMEOUT:
00818 case ENV_LOCK_TIMEOUT:
00819 if (i >= objc) {
00820 Tcl_WrongNumArgs(interp, 2, objv,
00821 "?-txn_timestamp time?");
00822 result = TCL_ERROR;
00823 break;
00824 }
00825
00826 if ((result = Tcl_GetLongFromObj(
00827 interp, objv[i++], &v)) != TCL_OK)
00828 break;
00829 timestamp = (time_t)v;
00830
00831 _debug_check();
00832 if ((enum envopen)optindex == ENV_TXN_TIME)
00833 ret =
00834 (*env)->set_tx_timestamp(*env, ×tamp);
00835 else
00836 ret = (*env)->set_timeout(*env,
00837 (db_timeout_t)timestamp,
00838 (enum envopen)optindex == ENV_TXN_TIMEOUT ?
00839 DB_SET_TXN_TIMEOUT : DB_SET_LOCK_TIMEOUT);
00840 result = _ReturnSetup(interp, ret,
00841 DB_RETOK_STD(ret), "txn_timestamp");
00842 break;
00843 case ENV_LOG:
00844 FLD_SET(open_flags, DB_INIT_LOG | DB_INIT_MPOOL);
00845 break;
00846 case ENV_LOG_BUFFER:
00847 if (i >= objc) {
00848 Tcl_WrongNumArgs(interp, 2, objv,
00849 "?-log_buffer size?");
00850 result = TCL_ERROR;
00851 break;
00852 }
00853 result = _GetUInt32(interp, objv[i++], &uintarg);
00854 if (result == TCL_OK) {
00855 _debug_check();
00856 ret = (*env)->set_lg_bsize(*env, uintarg);
00857 result = _ReturnSetup(interp, ret,
00858 DB_RETOK_STD(ret), "log_bsize");
00859 logbufset = 1;
00860 if (logmaxset) {
00861 _debug_check();
00862 ret = (*env)->set_lg_max(*env,
00863 logmaxset);
00864 result = _ReturnSetup(interp, ret,
00865 DB_RETOK_STD(ret), "log_max");
00866 logmaxset = 0;
00867 logbufset = 0;
00868 }
00869 }
00870 break;
00871 case ENV_LOG_FILEMODE:
00872 if (i >= objc) {
00873 Tcl_WrongNumArgs(interp, 2, objv,
00874 "?-log_filemode mode?");
00875 result = TCL_ERROR;
00876 break;
00877 }
00878 result = _GetUInt32(interp, objv[i++], &uintarg);
00879 if (result == TCL_OK) {
00880 _debug_check();
00881 ret =
00882 (*env)->set_lg_filemode(*env, (int)uintarg);
00883 result = _ReturnSetup(interp, ret,
00884 DB_RETOK_STD(ret), "log_filemode");
00885 }
00886 break;
00887 case ENV_LOG_INMEMORY:
00888 FLD_SET(set_flags, DB_LOG_INMEMORY);
00889 break;
00890 case ENV_LOG_MAX:
00891 if (i >= objc) {
00892 Tcl_WrongNumArgs(interp, 2, objv,
00893 "?-log_max max?");
00894 result = TCL_ERROR;
00895 break;
00896 }
00897 result = _GetUInt32(interp, objv[i++], &uintarg);
00898 if (result == TCL_OK && logbufset) {
00899 _debug_check();
00900 ret = (*env)->set_lg_max(*env, uintarg);
00901 result = _ReturnSetup(interp, ret,
00902 DB_RETOK_STD(ret), "log_max");
00903 logbufset = 0;
00904 } else
00905 logmaxset = uintarg;
00906 break;
00907 case ENV_LOG_REGIONMAX:
00908 if (i >= objc) {
00909 Tcl_WrongNumArgs(interp, 2, objv,
00910 "?-log_regionmax size?");
00911 result = TCL_ERROR;
00912 break;
00913 }
00914 result = _GetUInt32(interp, objv[i++], &uintarg);
00915 if (result == TCL_OK) {
00916 _debug_check();
00917 ret = (*env)->set_lg_regionmax(*env, uintarg);
00918 result =
00919 _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
00920 "log_regionmax");
00921 }
00922 break;
00923 case ENV_LOG_REMOVE:
00924 FLD_SET(set_flags, DB_LOG_AUTOREMOVE);
00925 break;
00926 case ENV_MPOOL_MAX_OPENFD:
00927 if (i >= objc) {
00928 Tcl_WrongNumArgs(interp, 2, objv,
00929 "?-mpool_max_openfd fd_count?");
00930 result = TCL_ERROR;
00931 break;
00932 }
00933 result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
00934 if (result == TCL_OK) {
00935 _debug_check();
00936 ret = (*env)->set_mp_max_openfd(*env, intarg);
00937 result = _ReturnSetup(interp, ret,
00938 DB_RETOK_STD(ret), "mpool_max_openfd");
00939 }
00940 break;
00941 case ENV_MPOOL_MAX_WRITE:
00942 result = Tcl_ListObjGetElements(interp, objv[i],
00943 &myobjc, &myobjv);
00944 if (result == TCL_OK)
00945 i++;
00946 else
00947 break;
00948 if (myobjc != 2) {
00949 Tcl_WrongNumArgs(interp, 2, objv,
00950 "?-mpool_max_write {nwrite nsleep}?");
00951 result = TCL_ERROR;
00952 break;
00953 }
00954 result = Tcl_GetIntFromObj(interp, myobjv[0], &intarg);
00955 if (result != TCL_OK)
00956 break;
00957 result = Tcl_GetIntFromObj(interp, myobjv[1], &intarg2);
00958 if (result != TCL_OK)
00959 break;
00960 _debug_check();
00961 ret = (*env)->set_mp_max_write(*env, intarg, intarg2);
00962 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
00963 "set_mp_max_write");
00964 break;
00965 case ENV_MPOOL_MMAP_SIZE:
00966 if (i >= objc) {
00967 Tcl_WrongNumArgs(interp, 2, objv,
00968 "?-mpool_mmap_size size?");
00969 result = TCL_ERROR;
00970 break;
00971 }
00972 result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
00973 if (result == TCL_OK) {
00974 _debug_check();
00975 ret = (*env)->set_mp_mmapsize(*env,
00976 (size_t)intarg);
00977 result = _ReturnSetup(interp, ret,
00978 DB_RETOK_STD(ret), "mpool_mmap_size");
00979 }
00980 break;
00981 case ENV_MPOOL_NOMMAP:
00982 FLD_SET(set_flags, DB_NOMMAP);
00983 break;
00984 case ENV_OVERWRITE:
00985 FLD_SET(set_flags, DB_OVERWRITE);
00986 break;
00987 case ENV_REGION_INIT:
00988 _debug_check();
00989 ret = (*env)->set_flags(*env, DB_REGION_INIT, 1);
00990 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
00991 "region_init");
00992 break;
00993 case ENV_SET_INTERMEDIATE_DIR:
00994 if (i >= objc) {
00995 Tcl_WrongNumArgs(interp,
00996 2, objv, "?-set_intermediate_dir mode?");
00997 result = TCL_ERROR;
00998 break;
00999 }
01000 result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
01001 if (result == TCL_OK) {
01002 _debug_check();
01003 ret = (*env)->
01004 set_intermediate_dir(*env, intarg, 0);
01005 result = _ReturnSetup(interp, ret,
01006 DB_RETOK_STD(ret), "set_intermediate_dir");
01007 }
01008 break;
01009 case ENV_REP:
01010 FLD_SET(open_flags, DB_INIT_REP);
01011 break;
01012 case ENV_REP_CLIENT:
01013 rep_flags = DB_REP_CLIENT;
01014 FLD_SET(open_flags, DB_INIT_REP);
01015 break;
01016 case ENV_REP_MASTER:
01017 rep_flags = DB_REP_MASTER;
01018 FLD_SET(open_flags, DB_INIT_REP);
01019 break;
01020 case ENV_REP_TRANSPORT:
01021 if (i >= objc) {
01022 Tcl_WrongNumArgs(interp, 2, objv,
01023 "-rep_transport {envid sendproc}");
01024 result = TCL_ERROR;
01025 break;
01026 }
01027 result = Tcl_ListObjGetElements(interp, objv[i],
01028 &myobjc, &myobjv);
01029 if (result == TCL_OK)
01030 i++;
01031 else
01032 break;
01033 result = tcl_RepTransport(interp, myobjc, myobjv,
01034 *env, ip);
01035 if (result == TCL_OK)
01036 FLD_SET(open_flags, DB_INIT_REP);
01037 break;
01038 case ENV_THREAD:
01039
01040 FLD_SET(open_flags, DB_THREAD);
01041 break;
01042 case ENV_TIME_NOTGRANTED:
01043 FLD_SET(set_flags, DB_TIME_NOTGRANTED);
01044 break;
01045 case ENV_VERBOSE:
01046 result = Tcl_ListObjGetElements(interp, objv[i],
01047 &myobjc, &myobjv);
01048 if (result == TCL_OK)
01049 i++;
01050 else
01051 break;
01052 if (myobjc != 2) {
01053 Tcl_WrongNumArgs(interp, 2, objv,
01054 "?-verbose {which on|off}?");
01055 result = TCL_ERROR;
01056 break;
01057 }
01058 result = tcl_EnvVerbose(interp, *env,
01059 myobjv[0], myobjv[1]);
01060 break;
01061 case ENV_WRNOSYNC:
01062 FLD_SET(set_flags, DB_TXN_WRITE_NOSYNC);
01063 break;
01064 #endif
01065 case ENV_TXN:
01066 FLD_SET(open_flags, DB_INIT_LOCK |
01067 DB_INIT_LOG | DB_INIT_MPOOL | DB_INIT_TXN);
01068
01069 if (i < objc) {
01070 arg = Tcl_GetStringFromObj(objv[i], NULL);
01071 if (strcmp(arg, "nosync") == 0) {
01072 FLD_SET(set_flags, DB_TXN_NOSYNC);
01073 i++;
01074 }
01075 }
01076 break;
01077 case ENV_CREATE:
01078 FLD_SET(open_flags, DB_CREATE | DB_INIT_MPOOL);
01079 break;
01080 case ENV_ENCRYPT_AES:
01081
01082 if (i >= objc) {
01083 Tcl_WrongNumArgs(interp, 2, objv,
01084 "?-encryptaes passwd?");
01085 result = TCL_ERROR;
01086 break;
01087 }
01088 passwd = Tcl_GetStringFromObj(objv[i++], NULL);
01089 _debug_check();
01090 ret = (*env)->set_encrypt(*env, passwd, DB_ENCRYPT_AES);
01091 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
01092 "set_encrypt");
01093 break;
01094 case ENV_ENCRYPT_ANY:
01095
01096 if (i >= objc) {
01097 Tcl_WrongNumArgs(interp, 2, objv,
01098 "?-encryptany passwd?");
01099 result = TCL_ERROR;
01100 break;
01101 }
01102 passwd = Tcl_GetStringFromObj(objv[i++], NULL);
01103 _debug_check();
01104 ret = (*env)->set_encrypt(*env, passwd, 0);
01105 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
01106 "set_encrypt");
01107 break;
01108 case ENV_HOME:
01109
01110 if (i >= objc) {
01111 Tcl_WrongNumArgs(interp, 2, objv,
01112 "?-home dir?");
01113 result = TCL_ERROR;
01114 break;
01115 }
01116 home = Tcl_GetStringFromObj(objv[i++], NULL);
01117 break;
01118 case ENV_MODE:
01119 if (i >= objc) {
01120 Tcl_WrongNumArgs(interp, 2, objv,
01121 "?-mode mode?");
01122 result = TCL_ERROR;
01123 break;
01124 }
01125
01126
01127
01128
01129
01130
01131 result = Tcl_GetIntFromObj(interp, objv[i++], &mode);
01132 break;
01133 case ENV_PRIVATE:
01134 FLD_SET(open_flags, DB_PRIVATE | DB_INIT_MPOOL);
01135 break;
01136 case ENV_RECOVER:
01137 FLD_SET(open_flags, DB_RECOVER);
01138 break;
01139 case ENV_RECOVER_FATAL:
01140 FLD_SET(open_flags, DB_RECOVER_FATAL);
01141 break;
01142 case ENV_REGISTER:
01143 FLD_SET(open_flags, DB_REGISTER);
01144 break;
01145 case ENV_SYSTEM_MEM:
01146 FLD_SET(open_flags, DB_SYSTEM_MEM);
01147 break;
01148 case ENV_USE_ENVIRON_ROOT:
01149 FLD_SET(open_flags, DB_USE_ENVIRON_ROOT);
01150 break;
01151 case ENV_USE_ENVIRON:
01152 FLD_SET(open_flags, DB_USE_ENVIRON);
01153 break;
01154 case ENV_CACHESIZE:
01155 result = Tcl_ListObjGetElements(interp, objv[i],
01156 &myobjc, &myobjv);
01157 if (result == TCL_OK)
01158 i++;
01159 else
01160 break;
01161 if (myobjc != 3) {
01162 Tcl_WrongNumArgs(interp, 2, objv,
01163 "?-cachesize {gbytes bytes ncaches}?");
01164 result = TCL_ERROR;
01165 break;
01166 }
01167 result = _GetUInt32(interp, myobjv[0], &gbytes);
01168 if (result != TCL_OK)
01169 break;
01170 result = _GetUInt32(interp, myobjv[1], &bytes);
01171 if (result != TCL_OK)
01172 break;
01173 result = Tcl_GetIntFromObj(interp, myobjv[2], &ncaches);
01174 if (result != TCL_OK)
01175 break;
01176 _debug_check();
01177 ret = (*env)->set_cachesize(*env, gbytes, bytes,
01178 ncaches);
01179 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
01180 "set_cachesize");
01181 break;
01182 case ENV_SHM_KEY:
01183 if (i >= objc) {
01184 Tcl_WrongNumArgs(interp, 2, objv,
01185 "?-shm_key key?");
01186 result = TCL_ERROR;
01187 break;
01188 }
01189 result = Tcl_GetLongFromObj(interp, objv[i++], &shm);
01190 if (result == TCL_OK) {
01191 _debug_check();
01192 ret = (*env)->set_shm_key(*env, shm);
01193 result = _ReturnSetup(interp, ret,
01194 DB_RETOK_STD(ret), "shm_key");
01195 }
01196 break;
01197 case ENV_TXN_MAX:
01198 if (i >= objc) {
01199 Tcl_WrongNumArgs(interp, 2, objv,
01200 "?-txn_max max?");
01201 result = TCL_ERROR;
01202 break;
01203 }
01204 result = _GetUInt32(interp, objv[i++], &uintarg);
01205 if (result == TCL_OK) {
01206 _debug_check();
01207 ret = (*env)->set_tx_max(*env, uintarg);
01208 result = _ReturnSetup(interp, ret,
01209 DB_RETOK_STD(ret), "txn_max");
01210 }
01211 break;
01212 case ENV_ERRFILE:
01213 if (i >= objc) {
01214 Tcl_WrongNumArgs(interp, 2, objv,
01215 "-errfile file");
01216 result = TCL_ERROR;
01217 break;
01218 }
01219 arg = Tcl_GetStringFromObj(objv[i++], NULL);
01220 tcl_EnvSetErrfile(interp, *env, ip, arg);
01221 break;
01222 case ENV_ERRPFX:
01223 if (i >= objc) {
01224 Tcl_WrongNumArgs(interp, 2, objv,
01225 "-errpfx prefix");
01226 result = TCL_ERROR;
01227 break;
01228 }
01229 arg = Tcl_GetStringFromObj(objv[i++], NULL);
01230 _debug_check();
01231 result = tcl_EnvSetErrpfx(interp, *env, ip, arg);
01232 break;
01233 case ENV_DATA_DIR:
01234 if (i >= objc) {
01235 Tcl_WrongNumArgs(interp, 2, objv,
01236 "-data_dir dir");
01237 result = TCL_ERROR;
01238 break;
01239 }
01240 arg = Tcl_GetStringFromObj(objv[i++], NULL);
01241 _debug_check();
01242 ret = (*env)->set_data_dir(*env, arg);
01243 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
01244 "set_data_dir");
01245 break;
01246 case ENV_LOG_DIR:
01247 if (i >= objc) {
01248 Tcl_WrongNumArgs(interp, 2, objv,
01249 "-log_dir dir");
01250 result = TCL_ERROR;
01251 break;
01252 }
01253 arg = Tcl_GetStringFromObj(objv[i++], NULL);
01254 _debug_check();
01255 ret = (*env)->set_lg_dir(*env, arg);
01256 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
01257 "set_lg_dir");
01258 break;
01259 case ENV_TMP_DIR:
01260 if (i >= objc) {
01261 Tcl_WrongNumArgs(interp, 2, objv,
01262 "-tmp_dir dir");
01263 result = TCL_ERROR;
01264 break;
01265 }
01266 arg = Tcl_GetStringFromObj(objv[i++], NULL);
01267 _debug_check();
01268 ret = (*env)->set_tmp_dir(*env, arg);
01269 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
01270 "set_tmp_dir");
01271 break;
01272 }
01273
01274
01275
01276
01277 if (result != TCL_OK)
01278 goto error;
01279 }
01280
01281
01282
01283
01284
01285
01286
01287
01288
01289 if (logmaxset) {
01290 _debug_check();
01291 ret = (*env)->set_lg_max(*env, (u_int32_t)logmaxset);
01292 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
01293 "log_max");
01294 }
01295
01296 if (result != TCL_OK)
01297 goto error;
01298
01299 if (set_flags) {
01300 ret = (*env)->set_flags(*env, set_flags, 1);
01301 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
01302 "set_flags");
01303 if (result == TCL_ERROR)
01304 goto error;
01305
01306
01307
01308
01309 Tcl_ResetResult(interp);
01310 }
01311
01312
01313
01314
01315
01316
01317
01318 _debug_check();
01319 ret = (*env)->open(*env, home, open_flags, mode);
01320 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "env open");
01321
01322 if (rep_flags != 0 && result == TCL_OK) {
01323 _debug_check();
01324 ret = (*env)->rep_start(*env, NULL, rep_flags);
01325 result = _ReturnSetup(interp,
01326 ret, DB_RETOK_STD(ret), "rep_start");
01327 }
01328
01329 error: if (result == TCL_ERROR) {
01330 if (ip->i_err && ip->i_err != stdout && ip->i_err != stderr) {
01331 (void)fclose(ip->i_err);
01332 ip->i_err = NULL;
01333 }
01334 (void)(*env)->close(*env, 0);
01335 *env = NULL;
01336 }
01337 return (result);
01338 }
01339
01340
01341
01342
01343
01344
01345
01346
01347
01348
01349
01350
01351
01352
01353 static int
01354 bdb_DbOpen(interp, objc, objv, ip, dbp)
01355 Tcl_Interp *interp;
01356 int objc;
01357 Tcl_Obj *CONST objv[];
01358 DBTCL_INFO *ip;
01359 DB **dbp;
01360 {
01361 static const char *bdbenvopen[] = {
01362 "-env", NULL
01363 };
01364 enum bdbenvopen {
01365 TCL_DB_ENV0
01366 };
01367 static const char *bdbopen[] = {
01368 #ifdef CONFIG_TEST
01369 "-btcompare",
01370 "-dupcompare",
01371 "-hashproc",
01372 "-lorder",
01373 "-minkey",
01374 "-nommap",
01375 "-notdurable",
01376 "-read_uncommitted",
01377 "-revsplitoff",
01378 "-test",
01379 "-thread",
01380 #endif
01381 "-auto_commit",
01382 "-btree",
01383 "-cachesize",
01384 "-chksum",
01385 "-create",
01386 "-delim",
01387 "-dup",
01388 "-dupsort",
01389 "-encrypt",
01390 "-encryptaes",
01391 "-encryptany",
01392 "-env",
01393 "-errfile",
01394 "-errpfx",
01395 "-excl",
01396 "-extent",
01397 "-ffactor",
01398 "-hash",
01399 "-inorder",
01400 "-len",
01401 "-maxsize",
01402 "-mode",
01403 "-nelem",
01404 "-pad",
01405 "-pagesize",
01406 "-queue",
01407 "-rdonly",
01408 "-recno",
01409 "-recnum",
01410 "-renumber",
01411 "-snapshot",
01412 "-source",
01413 "-truncate",
01414 "-txn",
01415 "-unknown",
01416 "--",
01417 NULL
01418 };
01419 enum bdbopen {
01420 #ifdef CONFIG_TEST
01421 TCL_DB_BTCOMPARE,
01422 TCL_DB_DUPCOMPARE,
01423 TCL_DB_HASHPROC,
01424 TCL_DB_LORDER,
01425 TCL_DB_MINKEY,
01426 TCL_DB_NOMMAP,
01427 TCL_DB_NOTDURABLE,
01428 TCL_DB_READ_UNCOMMITTED,
01429 TCL_DB_REVSPLIT,
01430 TCL_DB_TEST,
01431 TCL_DB_THREAD,
01432 #endif
01433 TCL_DB_AUTO_COMMIT,
01434 TCL_DB_BTREE,
01435 TCL_DB_CACHESIZE,
01436 TCL_DB_CHKSUM,
01437 TCL_DB_CREATE,
01438 TCL_DB_DELIM,
01439 TCL_DB_DUP,
01440 TCL_DB_DUPSORT,
01441 TCL_DB_ENCRYPT,
01442 TCL_DB_ENCRYPT_AES,
01443 TCL_DB_ENCRYPT_ANY,
01444 TCL_DB_ENV,
01445 TCL_DB_ERRFILE,
01446 TCL_DB_ERRPFX,
01447 TCL_DB_EXCL,
01448 TCL_DB_EXTENT,
01449 TCL_DB_FFACTOR,
01450 TCL_DB_HASH,
01451 TCL_DB_INORDER,
01452 TCL_DB_LEN,
01453 TCL_DB_MAXSIZE,
01454 TCL_DB_MODE,
01455 TCL_DB_NELEM,
01456 TCL_DB_PAD,
01457 TCL_DB_PAGESIZE,
01458 TCL_DB_QUEUE,
01459 TCL_DB_RDONLY,
01460 TCL_DB_RECNO,
01461 TCL_DB_RECNUM,
01462 TCL_DB_RENUMBER,
01463 TCL_DB_SNAPSHOT,
01464 TCL_DB_SOURCE,
01465 TCL_DB_TRUNCATE,
01466 TCL_DB_TXN,
01467 TCL_DB_UNKNOWN,
01468 TCL_DB_ENDARG
01469 };
01470
01471 DBTCL_INFO *envip, *errip;
01472 DB_TXN *txn;
01473 DBTYPE type;
01474 DB_ENV *envp;
01475 Tcl_Obj **myobjv;
01476 u_int32_t gbytes, bytes, open_flags, set_flags, uintarg;
01477 int endarg, i, intarg, mode, myobjc, ncaches;
01478 int optindex, result, ret, set_err, set_pfx, subdblen;
01479 u_char *subdbtmp;
01480 char *arg, *db, *passwd, *subdb, msg[MSG_SIZE];
01481
01482 type = DB_UNKNOWN;
01483 endarg = mode = set_err = set_flags = set_pfx = 0;
01484 result = TCL_OK;
01485 subdbtmp = NULL;
01486 db = subdb = NULL;
01487
01488
01489
01490
01491
01492
01493
01494
01495
01496
01497
01498
01499
01500
01501 open_flags = 0;
01502
01503 envp = NULL;
01504 txn = NULL;
01505
01506 if (objc < 2) {
01507 Tcl_WrongNumArgs(interp, 2, objv, "?args?");
01508 return (TCL_ERROR);
01509 }
01510
01511
01512
01513
01514
01515 i = 2;
01516 while (i < objc) {
01517 if (Tcl_GetIndexFromObj(interp, objv[i++], bdbenvopen,
01518 "option", TCL_EXACT, &optindex) != TCL_OK) {
01519
01520
01521
01522
01523 Tcl_ResetResult(interp);
01524 continue;
01525 }
01526 switch ((enum bdbenvopen)optindex) {
01527 case TCL_DB_ENV0:
01528 arg = Tcl_GetStringFromObj(objv[i], NULL);
01529 envp = NAME_TO_ENV(arg);
01530 if (envp == NULL) {
01531 Tcl_SetResult(interp,
01532 "db open: illegal environment", TCL_STATIC);
01533 return (TCL_ERROR);
01534 }
01535 }
01536 break;
01537 }
01538
01539
01540
01541
01542
01543 ret = db_create(dbp, envp, 0);
01544 if (ret)
01545 return (_ReturnSetup(interp, ret, DB_RETOK_STD(ret),
01546 "db_create"));
01547
01548
01549 (*dbp)->api_internal = ip;
01550
01551
01552
01553
01554
01555
01556
01557
01558
01559
01560
01561 if (envp == NULL) {
01562 (*dbp)->set_errpfx((*dbp), ip->i_name);
01563 (*dbp)->set_errcall((*dbp), _ErrorFunc);
01564 }
01565 envip = _PtrToInfo(envp);
01566
01567
01568
01569
01570 if (envip)
01571 errip = envip;
01572 else
01573 errip = ip;
01574
01575
01576
01577
01578 i = 2;
01579 while (i < objc) {
01580 Tcl_ResetResult(interp);
01581 if (Tcl_GetIndexFromObj(interp, objv[i], bdbopen, "option",
01582 TCL_EXACT, &optindex) != TCL_OK) {
01583 arg = Tcl_GetStringFromObj(objv[i], NULL);
01584 if (arg[0] == '-') {
01585 result = IS_HELP(objv[i]);
01586 goto error;
01587 } else
01588 Tcl_ResetResult(interp);
01589 break;
01590 }
01591 i++;
01592 switch ((enum bdbopen)optindex) {
01593 #ifdef CONFIG_TEST
01594 case TCL_DB_BTCOMPARE:
01595 if (i >= objc) {
01596 Tcl_WrongNumArgs(interp, 2, objv,
01597 "-btcompare compareproc");
01598 result = TCL_ERROR;
01599 break;
01600 }
01601
01602
01603
01604
01605
01606
01607
01608
01609 ip->i_btcompare = objv[i++];
01610 Tcl_IncrRefCount(ip->i_btcompare);
01611 _debug_check();
01612 ret = (*dbp)->set_bt_compare(*dbp, tcl_bt_compare);
01613 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
01614 "set_bt_compare");
01615 break;
01616 case TCL_DB_DUPCOMPARE:
01617 if (i >= objc) {
01618 Tcl_WrongNumArgs(interp, 2, objv,
01619 "-dupcompare compareproc");
01620 result = TCL_ERROR;
01621 break;
01622 }
01623
01624
01625
01626
01627
01628 ip->i_dupcompare = objv[i++];
01629 Tcl_IncrRefCount(ip->i_dupcompare);
01630 _debug_check();
01631 ret = (*dbp)->set_dup_compare(*dbp, tcl_dup_compare);
01632 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
01633 "set_dup_compare");
01634 break;
01635 case TCL_DB_HASHPROC:
01636 if (i >= objc) {
01637 Tcl_WrongNumArgs(interp, 2, objv,
01638 "-hashproc hashproc");
01639 result = TCL_ERROR;
01640 break;
01641 }
01642
01643
01644
01645
01646
01647 ip->i_hashproc = objv[i++];
01648 Tcl_IncrRefCount(ip->i_hashproc);
01649 _debug_check();
01650 ret = (*dbp)->set_h_hash(*dbp, tcl_h_hash);
01651 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
01652 "set_h_hash");
01653 break;
01654 case TCL_DB_LORDER:
01655 if (i >= objc) {
01656 Tcl_WrongNumArgs(interp, 2, objv,
01657 "-lorder 1234|4321");
01658 result = TCL_ERROR;
01659 break;
01660 }
01661 result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
01662 if (result == TCL_OK) {
01663 _debug_check();
01664 ret = (*dbp)->set_lorder(*dbp, intarg);
01665 result = _ReturnSetup(interp, ret,
01666 DB_RETOK_STD(ret), "set_lorder");
01667 }
01668 break;
01669 case TCL_DB_MINKEY:
01670 if (i >= objc) {
01671 Tcl_WrongNumArgs(interp, 2, objv,
01672 "-minkey minkey");
01673 result = TCL_ERROR;
01674 break;
01675 }
01676 result = _GetUInt32(interp, objv[i++], &uintarg);
01677 if (result == TCL_OK) {
01678 _debug_check();
01679 ret = (*dbp)->set_bt_minkey(*dbp, uintarg);
01680 result = _ReturnSetup(interp, ret,
01681 DB_RETOK_STD(ret), "set_bt_minkey");
01682 }
01683 break;
01684 case TCL_DB_NOMMAP:
01685 open_flags |= DB_NOMMAP;
01686 break;
01687 case TCL_DB_NOTDURABLE:
01688 set_flags |= DB_TXN_NOT_DURABLE;
01689 break;
01690 case TCL_DB_READ_UNCOMMITTED:
01691 open_flags |= DB_READ_UNCOMMITTED;
01692 break;
01693 case TCL_DB_REVSPLIT:
01694 set_flags |= DB_REVSPLITOFF;
01695 break;
01696 case TCL_DB_TEST:
01697 ret = (*dbp)->set_h_hash(*dbp, __ham_test);
01698 result = _ReturnSetup(interp, ret,
01699 DB_RETOK_STD(ret), "set_h_hash");
01700 break;
01701 case TCL_DB_THREAD:
01702
01703 open_flags |= DB_THREAD;
01704 break;
01705 #endif
01706 case TCL_DB_AUTO_COMMIT:
01707 open_flags |= DB_AUTO_COMMIT;
01708 break;
01709 case TCL_DB_ENV:
01710
01711
01712
01713 i++;
01714 continue;
01715 case TCL_DB_TXN:
01716 if (i > (objc - 1)) {
01717 Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?");
01718 result = TCL_ERROR;
01719 break;
01720 }
01721 arg = Tcl_GetStringFromObj(objv[i++], NULL);
01722 txn = NAME_TO_TXN(arg);
01723 if (txn == NULL) {
01724 snprintf(msg, MSG_SIZE,
01725 "Open: Invalid txn: %s\n", arg);
01726 Tcl_SetResult(interp, msg, TCL_VOLATILE);
01727 result = TCL_ERROR;
01728 }
01729 break;
01730 case TCL_DB_BTREE:
01731 if (type != DB_UNKNOWN) {
01732 Tcl_SetResult(interp,
01733 "Too many DB types specified", TCL_STATIC);
01734 result = TCL_ERROR;
01735 goto error;
01736 }
01737 type = DB_BTREE;
01738 break;
01739 case TCL_DB_HASH:
01740 if (type != DB_UNKNOWN) {
01741 Tcl_SetResult(interp,
01742 "Too many DB types specified", TCL_STATIC);
01743 result = TCL_ERROR;
01744 goto error;
01745 }
01746 type = DB_HASH;
01747 break;
01748 case TCL_DB_RECNO:
01749 if (type != DB_UNKNOWN) {
01750 Tcl_SetResult(interp,
01751 "Too many DB types specified", TCL_STATIC);
01752 result = TCL_ERROR;
01753 goto error;
01754 }
01755 type = DB_RECNO;
01756 break;
01757 case TCL_DB_QUEUE:
01758 if (type != DB_UNKNOWN) {
01759 Tcl_SetResult(interp,
01760 "Too many DB types specified", TCL_STATIC);
01761 result = TCL_ERROR;
01762 goto error;
01763 }
01764 type = DB_QUEUE;
01765 break;
01766 case TCL_DB_UNKNOWN:
01767 if (type != DB_UNKNOWN) {
01768 Tcl_SetResult(interp,
01769 "Too many DB types specified", TCL_STATIC);
01770 result = TCL_ERROR;
01771 goto error;
01772 }
01773 break;
01774 case TCL_DB_CREATE:
01775 open_flags |= DB_CREATE;
01776 break;
01777 case TCL_DB_EXCL:
01778 open_flags |= DB_EXCL;
01779 break;
01780 case TCL_DB_RDONLY:
01781 open_flags |= DB_RDONLY;
01782 break;
01783 case TCL_DB_TRUNCATE:
01784 open_flags |= DB_TRUNCATE;
01785 break;
01786 case TCL_DB_MODE:
01787 if (i >= objc) {
01788 Tcl_WrongNumArgs(interp, 2, objv,
01789 "?-mode mode?");
01790 result = TCL_ERROR;
01791 break;
01792 }
01793
01794
01795
01796
01797
01798
01799 result = Tcl_GetIntFromObj(interp, objv[i++], &mode);
01800 break;
01801 case TCL_DB_DUP:
01802 set_flags |= DB_DUP;
01803 break;
01804 case TCL_DB_DUPSORT:
01805 set_flags |= DB_DUPSORT;
01806 break;
01807 case TCL_DB_INORDER:
01808 set_flags |= DB_INORDER;
01809 break;
01810 case TCL_DB_RECNUM:
01811 set_flags |= DB_RECNUM;
01812 break;
01813 case TCL_DB_RENUMBER:
01814 set_flags |= DB_RENUMBER;
01815 break;
01816 case TCL_DB_SNAPSHOT:
01817 set_flags |= DB_SNAPSHOT;
01818 break;
01819 case TCL_DB_CHKSUM:
01820 set_flags |= DB_CHKSUM;
01821 break;
01822 case TCL_DB_ENCRYPT:
01823 set_flags |= DB_ENCRYPT;
01824 break;
01825 case TCL_DB_ENCRYPT_AES:
01826
01827 if (i >= objc) {
01828 Tcl_WrongNumArgs(interp, 2, objv,
01829 "?-encryptaes passwd?");
01830 result = TCL_ERROR;
01831 break;
01832 }
01833 passwd = Tcl_GetStringFromObj(objv[i++], NULL);
01834 _debug_check();
01835 ret = (*dbp)->set_encrypt(*dbp, passwd, DB_ENCRYPT_AES);
01836 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
01837 "set_encrypt");
01838 break;
01839 case TCL_DB_ENCRYPT_ANY:
01840
01841 if (i >= objc) {
01842 Tcl_WrongNumArgs(interp, 2, objv,
01843 "?-encryptany passwd?");
01844 result = TCL_ERROR;
01845 break;
01846 }
01847 passwd = Tcl_GetStringFromObj(objv[i++], NULL);
01848 _debug_check();
01849 ret = (*dbp)->set_encrypt(*dbp, passwd, 0);
01850 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
01851 "set_encrypt");
01852 break;
01853 case TCL_DB_FFACTOR:
01854 if (i >= objc) {
01855 Tcl_WrongNumArgs(interp, 2, objv,
01856 "-ffactor density");
01857 result = TCL_ERROR;
01858 break;
01859 }
01860 result = _GetUInt32(interp, objv[i++], &uintarg);
01861 if (result == TCL_OK) {
01862 _debug_check();
01863 ret = (*dbp)->set_h_ffactor(*dbp, uintarg);
01864 result = _ReturnSetup(interp, ret,
01865 DB_RETOK_STD(ret), "set_h_ffactor");
01866 }
01867 break;
01868 case TCL_DB_NELEM:
01869 if (i >= objc) {
01870 Tcl_WrongNumArgs(interp, 2, objv,
01871 "-nelem nelem");
01872 result = TCL_ERROR;
01873 break;
01874 }
01875 result = _GetUInt32(interp, objv[i++], &uintarg);
01876 if (result == TCL_OK) {
01877 _debug_check();
01878 ret = (*dbp)->set_h_nelem(*dbp, uintarg);
01879 result = _ReturnSetup(interp, ret,
01880 DB_RETOK_STD(ret), "set_h_nelem");
01881 }
01882 break;
01883 case TCL_DB_DELIM:
01884 if (i >= objc) {
01885 Tcl_WrongNumArgs(interp, 2, objv,
01886 "-delim delim");
01887 result = TCL_ERROR;
01888 break;
01889 }
01890 result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
01891 if (result == TCL_OK) {
01892 _debug_check();
01893 ret = (*dbp)->set_re_delim(*dbp, intarg);
01894 result = _ReturnSetup(interp, ret,
01895 DB_RETOK_STD(ret), "set_re_delim");
01896 }
01897 break;
01898 case TCL_DB_LEN:
01899 if (i >= objc) {
01900 Tcl_WrongNumArgs(interp, 2, objv,
01901 "-len length");
01902 result = TCL_ERROR;
01903 break;
01904 }
01905 result = _GetUInt32(interp, objv[i++], &uintarg);
01906 if (result == TCL_OK) {
01907 _debug_check();
01908 ret = (*dbp)->set_re_len(*dbp, uintarg);
01909 result = _ReturnSetup(interp, ret,
01910 DB_RETOK_STD(ret), "set_re_len");
01911 }
01912 break;
01913 case TCL_DB_MAXSIZE:
01914 if (i >= objc) {
01915 Tcl_WrongNumArgs(interp, 2, objv,
01916 "-len length");
01917 result = TCL_ERROR;
01918 break;
01919 }
01920 result = _GetUInt32(interp, objv[i++], &uintarg);
01921 if (result == TCL_OK) {
01922 _debug_check();
01923 ret = (*dbp)->mpf->set_maxsize(
01924 (*dbp)->mpf, 0, uintarg);
01925 result = _ReturnSetup(interp, ret,
01926 DB_RETOK_STD(ret), "set_re_len");
01927 }
01928 break;
01929 case TCL_DB_PAD:
01930 if (i >= objc) {
01931 Tcl_WrongNumArgs(interp, 2, objv,
01932 "-pad pad");
01933 result = TCL_ERROR;
01934 break;
01935 }
01936 result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
01937 if (result == TCL_OK) {
01938 _debug_check();
01939 ret = (*dbp)->set_re_pad(*dbp, intarg);
01940 result = _ReturnSetup(interp, ret,
01941 DB_RETOK_STD(ret), "set_re_pad");
01942 }
01943 break;
01944 case TCL_DB_SOURCE:
01945 if (i >= objc) {
01946 Tcl_WrongNumArgs(interp, 2, objv,
01947 "-source file");
01948 result = TCL_ERROR;
01949 break;
01950 }
01951 arg = Tcl_GetStringFromObj(objv[i++], NULL);
01952 _debug_check();
01953 ret = (*dbp)->set_re_source(*dbp, arg);
01954 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
01955 "set_re_source");
01956 break;
01957 case TCL_DB_EXTENT:
01958 if (i >= objc) {
01959 Tcl_WrongNumArgs(interp, 2, objv,
01960 "-extent size");
01961 result = TCL_ERROR;
01962 break;
01963 }
01964 result = _GetUInt32(interp, objv[i++], &uintarg);
01965 if (result == TCL_OK) {
01966 _debug_check();
01967 ret = (*dbp)->set_q_extentsize(*dbp, uintarg);
01968 result = _ReturnSetup(interp, ret,
01969 DB_RETOK_STD(ret), "set_q_extentsize");
01970 }
01971 break;
01972 case TCL_DB_CACHESIZE:
01973 result = Tcl_ListObjGetElements(interp, objv[i++],
01974 &myobjc, &myobjv);
01975 if (result != TCL_OK)
01976 break;
01977 if (myobjc != 3) {
01978 Tcl_WrongNumArgs(interp, 2, objv,
01979 "?-cachesize {gbytes bytes ncaches}?");
01980 result = TCL_ERROR;
01981 break;
01982 }
01983 result = _GetUInt32(interp, myobjv[0], &gbytes);
01984 if (result != TCL_OK)
01985 break;
01986 result = _GetUInt32(interp, myobjv[1], &bytes);
01987 if (result != TCL_OK)
01988 break;
01989 result = Tcl_GetIntFromObj(interp, myobjv[2], &ncaches);
01990 if (result != TCL_OK)
01991 break;
01992 _debug_check();
01993 ret = (*dbp)->set_cachesize(*dbp, gbytes, bytes,
01994 ncaches);
01995 result = _ReturnSetup(interp, ret,
01996 DB_RETOK_STD(ret), "set_cachesize");
01997 break;
01998 case TCL_DB_PAGESIZE:
01999 if (i >= objc) {
02000 Tcl_WrongNumArgs(interp, 2, objv,
02001 "?-pagesize size?");
02002 result = TCL_ERROR;
02003 break;
02004 }
02005 result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
02006 if (result == TCL_OK) {
02007 _debug_check();
02008 ret = (*dbp)->set_pagesize(*dbp,
02009 (size_t)intarg);
02010 result = _ReturnSetup(interp, ret,
02011 DB_RETOK_STD(ret), "set pagesize");
02012 }
02013 break;
02014 case TCL_DB_ERRFILE:
02015 if (i >= objc) {
02016 Tcl_WrongNumArgs(interp, 2, objv,
02017 "-errfile file");
02018 result = TCL_ERROR;
02019 break;
02020 }
02021 arg = Tcl_GetStringFromObj(objv[i++], NULL);
02022
02023
02024
02025 if (errip->i_err != NULL &&
02026 errip->i_err != stdout && errip->i_err != stderr)
02027 (void)fclose(errip->i_err);
02028 if (strcmp(arg, "/dev/stdout") == 0)
02029 errip->i_err = stdout;
02030 else if (strcmp(arg, "/dev/stderr") == 0)
02031 errip->i_err = stderr;
02032 else
02033 errip->i_err = fopen(arg, "a");
02034 if (errip->i_err != NULL) {
02035 _debug_check();
02036 (*dbp)->set_errfile(*dbp, errip->i_err);
02037 set_err = 1;
02038 }
02039 break;
02040 case TCL_DB_ERRPFX:
02041 if (i >= objc) {
02042 Tcl_WrongNumArgs(interp, 2, objv,
02043 "-errpfx prefix");
02044 result = TCL_ERROR;
02045 break;
02046 }
02047 arg = Tcl_GetStringFromObj(objv[i++], NULL);
02048
02049
02050
02051 if (errip->i_errpfx != NULL)
02052 __os_free(NULL, errip->i_errpfx);
02053 if ((ret = __os_strdup((*dbp)->dbenv,
02054 arg, &errip->i_errpfx)) != 0) {
02055 result = _ReturnSetup(interp, ret,
02056 DB_RETOK_STD(ret), "__os_strdup");
02057 break;
02058 }
02059 if (errip->i_errpfx != NULL) {
02060 _debug_check();
02061 (*dbp)->set_errpfx(*dbp, errip->i_errpfx);
02062 set_pfx = 1;
02063 }
02064 break;
02065 case TCL_DB_ENDARG:
02066 endarg = 1;
02067 break;
02068 }
02069
02070
02071
02072
02073
02074 if (result != TCL_OK)
02075 goto error;
02076 if (endarg)
02077 break;
02078 }
02079 if (result != TCL_OK)
02080 goto error;
02081
02082
02083
02084
02085
02086
02087 if (i != objc) {
02088
02089
02090
02091
02092
02093 db = Tcl_GetStringFromObj(objv[i++], NULL);
02094 if (strcmp(db, "") == 0)
02095 db = NULL;
02096 if (i != objc) {
02097 subdbtmp =
02098 Tcl_GetByteArrayFromObj(objv[i++], &subdblen);
02099 if ((ret = __os_malloc(envp,
02100 (size_t)subdblen + 1, &subdb)) != 0) {
02101 Tcl_SetResult(interp, db_strerror(ret),
02102 TCL_STATIC);
02103 return (0);
02104 }
02105 memcpy(subdb, subdbtmp, (size_t)subdblen);
02106 subdb[subdblen] = '\0';
02107 }
02108 }
02109 if (set_flags) {
02110 ret = (*dbp)->set_flags(*dbp, set_flags);
02111 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
02112 "set_flags");
02113 if (result == TCL_ERROR)
02114 goto error;
02115
02116
02117
02118
02119 Tcl_ResetResult(interp);
02120 }
02121
02122
02123
02124
02125
02126
02127 _debug_check();
02128
02129
02130 ret = (*dbp)->open(*dbp, txn, db, subdb, type, open_flags, mode);
02131 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db open");
02132
02133 error:
02134 if (subdb)
02135 __os_free(envp, subdb);
02136 if (result == TCL_ERROR) {
02137 (void)(*dbp)->close(*dbp, 0);
02138
02139
02140
02141
02142
02143
02144
02145
02146
02147
02148
02149 if (set_err && errip && errip->i_err != NULL &&
02150 errip->i_err != stdout && errip->i_err != stderr) {
02151 (void)fclose(errip->i_err);
02152 errip->i_err = NULL;
02153 }
02154 if (set_pfx && errip && errip->i_errpfx != NULL) {
02155 __os_free(envp, errip->i_errpfx);
02156 errip->i_errpfx = NULL;
02157 }
02158 *dbp = NULL;
02159 }
02160 return (result);
02161 }
02162
02163 #ifdef HAVE_SEQUENCE
02164
02165
02166
02167
02168 static int
02169 bdb_SeqOpen(interp, objc, objv, ip, seqp)
02170 Tcl_Interp *interp;
02171 int objc;
02172 Tcl_Obj *CONST objv[];
02173 DBTCL_INFO *ip;
02174 DB_SEQUENCE **seqp;
02175 {
02176 static const char *seqopen[] = {
02177 "-cachesize",
02178 "-create",
02179 "-inc",
02180 "-init",
02181 "-dec",
02182 "-max",
02183 "-min",
02184 "-thread",
02185 "-txn",
02186 "-wrap",
02187 "--",
02188 NULL
02189 } ;
02190 enum seqopen {
02191 TCL_SEQ_CACHESIZE,
02192 TCL_SEQ_CREATE,
02193 TCL_SEQ_INC,
02194 TCL_SEQ_INIT,
02195 TCL_SEQ_DEC,
02196 TCL_SEQ_MAX,
02197 TCL_SEQ_MIN,
02198 TCL_SEQ_THREAD,
02199 TCL_SEQ_TXN,
02200 TCL_SEQ_WRAP,
02201 TCL_SEQ_ENDARG
02202 };
02203 DB *dbp;
02204 DBT key;
02205 DBTYPE type;
02206 DB_TXN *txn;
02207 db_recno_t recno;
02208 db_seq_t min, max, value;
02209 Tcl_WideInt tcl_value;
02210 u_int32_t flags, oflags;
02211 int cache, endarg, i, optindex, result, ret, setrange, setvalue, v;
02212 char *arg, *db, msg[MSG_SIZE];
02213
02214 COMPQUIET(ip, NULL);
02215 COMPQUIET(value, 0);
02216 *seqp = NULL;
02217
02218 if (objc < 2) {
02219 Tcl_WrongNumArgs(interp, 2, objv, "?args?");
02220 return (TCL_ERROR);
02221 }
02222
02223 txn = NULL;
02224 endarg = 0;
02225 flags = oflags = 0;
02226 setrange = setvalue = 0;
02227 min = INT64_MIN;
02228 max = INT64_MAX;
02229 cache = 0;
02230
02231 for (i = 2; i < objc;) {
02232 Tcl_ResetResult(interp);
02233 if (Tcl_GetIndexFromObj(interp, objv[i], seqopen, "option",
02234 TCL_EXACT, &optindex) != TCL_OK) {
02235 arg = Tcl_GetStringFromObj(objv[i], NULL);
02236 if (arg[0] == '-') {
02237 result = IS_HELP(objv[i]);
02238 goto error;
02239 } else
02240 Tcl_ResetResult(interp);
02241 break;
02242 }
02243 i++;
02244 result = TCL_OK;
02245 switch ((enum seqopen)optindex) {
02246 case TCL_SEQ_CREATE:
02247 oflags |= DB_CREATE;
02248 break;
02249 case TCL_SEQ_INC:
02250 LF_SET(DB_SEQ_INC);
02251 break;
02252 case TCL_SEQ_CACHESIZE:
02253 if (i >= objc) {
02254 Tcl_WrongNumArgs(interp, 2, objv,
02255 "?-cachesize value?");
02256 result = TCL_ERROR;
02257 break;
02258 }
02259 result = Tcl_GetIntFromObj(interp, objv[i++], &cache);
02260 break;
02261 case TCL_SEQ_INIT:
02262 if (i >= objc) {
02263 Tcl_WrongNumArgs(interp, 2, objv,
02264 "?-init value?");
02265 result = TCL_ERROR;
02266 break;
02267 }
02268 result =
02269 Tcl_GetWideIntFromObj(
02270 interp, objv[i++], &tcl_value);
02271 value = tcl_value;
02272 setvalue = 1;
02273 break;
02274 case TCL_SEQ_DEC:
02275 LF_SET(DB_SEQ_DEC);
02276 break;
02277 case TCL_SEQ_MAX:
02278 if (i >= objc) {
02279 Tcl_WrongNumArgs(interp, 2, objv,
02280 "?-max value?");
02281 result = TCL_ERROR;
02282 break;
02283 }
02284 if ((result =
02285 Tcl_GetWideIntFromObj(interp,
02286 objv[i++], &tcl_value)) != TCL_OK)
02287 goto error;
02288 max = tcl_value;
02289 setrange = 1;
02290 break;
02291 case TCL_SEQ_MIN:
02292 if (i >= objc) {
02293 Tcl_WrongNumArgs(interp, 2, objv,
02294 "?-min value?");
02295 result = TCL_ERROR;
02296 break;
02297 }
02298 if ((result =
02299 Tcl_GetWideIntFromObj(interp,
02300 objv[i++], &tcl_value)) != TCL_OK)
02301 goto error;
02302 min = tcl_value;
02303 setrange = 1;
02304 break;
02305 case TCL_SEQ_THREAD:
02306 oflags |= DB_THREAD;
02307 break;
02308 case TCL_SEQ_TXN:
02309 if (i > (objc - 1)) {
02310 Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?");
02311 result = TCL_ERROR;
02312 break;
02313 }
02314 arg = Tcl_GetStringFromObj(objv[i++], NULL);
02315 txn = NAME_TO_TXN(arg);
02316 if (txn == NULL) {
02317 snprintf(msg, MSG_SIZE,
02318 "Sequence: Invalid txn: %s\n", arg);
02319 Tcl_SetResult(interp, msg, TCL_VOLATILE);
02320 result = TCL_ERROR;
02321 }
02322 break;
02323 case TCL_SEQ_WRAP:
02324 LF_SET(DB_SEQ_WRAP);
02325 break;
02326 case TCL_SEQ_ENDARG:
02327 endarg = 1;
02328 break;
02329 }
02330
02331
02332
02333
02334 if (result != TCL_OK)
02335 goto error;
02336 if (endarg)
02337 break;
02338 }
02339
02340 if (objc - i != 2) {
02341 Tcl_WrongNumArgs(interp, 2, objv, "?args?");
02342 return (TCL_ERROR);
02343 }
02344
02345
02346
02347
02348 db = Tcl_GetStringFromObj(objv[i++], NULL);
02349 if ((dbp = NAME_TO_DB(db)) == NULL) {
02350 Tcl_SetResult(interp, "No such dbp", TCL_STATIC);
02351 return (TCL_ERROR);
02352 }
02353 (void)dbp->get_type(dbp, &type);
02354
02355 memset(&key, 0, sizeof(key));
02356 if (type == DB_QUEUE || type == DB_RECNO) {
02357 result = _GetUInt32(interp, objv[i++], &recno);
02358 if (result != TCL_OK)
02359 return (result);
02360 key.data = &recno;
02361 key.size = sizeof(recno);
02362 } else {
02363 key.data = Tcl_GetByteArrayFromObj(objv[i++], &v);
02364 key.size = (u_int32_t)v;
02365 }
02366 ret = db_sequence_create(seqp, dbp, 0);
02367 if ((result = _ReturnSetup(interp,
02368 ret, DB_RETOK_STD(ret), "sequence create")) != TCL_OK) {
02369 *seqp = NULL;
02370 return (result);
02371 }
02372
02373 ret = (*seqp)->set_flags(*seqp, flags);
02374 if ((result = _ReturnSetup(interp,
02375 ret, DB_RETOK_STD(ret), "sequence set_flags")) != TCL_OK)
02376 goto error;
02377 if (setrange) {
02378 ret = (*seqp)->set_range(*seqp, min, max);
02379 if ((result = _ReturnSetup(interp,
02380 ret, DB_RETOK_STD(ret), "sequence set_range")) != TCL_OK)
02381 goto error;
02382 }
02383 if (cache) {
02384 ret = (*seqp)->set_cachesize(*seqp, cache);
02385 if ((result = _ReturnSetup(interp,
02386 ret, DB_RETOK_STD(ret), "sequence cachesize")) != TCL_OK)
02387 goto error;
02388 }
02389 if (setvalue) {
02390 ret = (*seqp)->initial_value(*seqp, value);
02391 if ((result = _ReturnSetup(interp,
02392 ret, DB_RETOK_STD(ret), "sequence init")) != TCL_OK)
02393 goto error;
02394 }
02395 ret = (*seqp)->open(*seqp, txn, &key, oflags);
02396 if ((result = _ReturnSetup(interp,
02397 ret, DB_RETOK_STD(ret), "sequence open")) != TCL_OK)
02398 goto error;
02399
02400 if (0) {
02401 error: if (*seqp != NULL)
02402 (void)(*seqp)->close(*seqp, 0);
02403 *seqp = NULL;
02404 }
02405 return (result);
02406 }
02407 #endif
02408
02409
02410
02411
02412
02413 static int
02414 bdb_DbRemove(interp, objc, objv)
02415 Tcl_Interp *interp;
02416 int objc;
02417 Tcl_Obj *CONST objv[];
02418 {
02419 static const char *bdbrem[] = {
02420 "-auto_commit",
02421 "-encrypt",
02422 "-encryptaes",
02423 "-encryptany",
02424 "-env",
02425 "-txn",
02426 "--",
02427 NULL
02428 };
02429 enum bdbrem {
02430 TCL_DBREM_AUTOCOMMIT,
02431 TCL_DBREM_ENCRYPT,
02432 TCL_DBREM_ENCRYPT_AES,
02433 TCL_DBREM_ENCRYPT_ANY,
02434 TCL_DBREM_ENV,
02435 TCL_DBREM_TXN,
02436 TCL_DBREM_ENDARG
02437 };
02438 DB *dbp;
02439 DB_ENV *envp;
02440 DB_TXN *txn;
02441 int endarg, i, optindex, result, ret, subdblen;
02442 u_int32_t enc_flag, iflags, set_flags;
02443 u_char *subdbtmp;
02444 char *arg, *db, msg[MSG_SIZE], *passwd, *subdb;
02445
02446 db = subdb = NULL;
02447 dbp = NULL;
02448 endarg = 0;
02449 envp = NULL;
02450 iflags = enc_flag = set_flags = 0;
02451 passwd = NULL;
02452 result = TCL_OK;
02453 subdbtmp = NULL;
02454 txn = NULL;
02455
02456 if (objc < 2) {
02457 Tcl_WrongNumArgs(interp, 2, objv, "?args? filename ?database?");
02458 return (TCL_ERROR);
02459 }
02460
02461
02462
02463
02464
02465 i = 2;
02466 while (i < objc) {
02467 if (Tcl_GetIndexFromObj(interp, objv[i], bdbrem,
02468 "option", TCL_EXACT, &optindex) != TCL_OK) {
02469 arg = Tcl_GetStringFromObj(objv[i], NULL);
02470 if (arg[0] == '-') {
02471 result = IS_HELP(objv[i]);
02472 goto error;
02473 } else
02474 Tcl_ResetResult(interp);
02475 break;
02476 }
02477 i++;
02478 switch ((enum bdbrem)optindex) {
02479 case TCL_DBREM_AUTOCOMMIT:
02480 iflags |= DB_AUTO_COMMIT;
02481 _debug_check();
02482 break;
02483 case TCL_DBREM_ENCRYPT:
02484 set_flags |= DB_ENCRYPT;
02485 _debug_check();
02486 break;
02487 case TCL_DBREM_ENCRYPT_AES:
02488
02489 if (i >= objc) {
02490 Tcl_WrongNumArgs(interp, 2, objv,
02491 "?-encryptaes passwd?");
02492 result = TCL_ERROR;
02493 break;
02494 }
02495 passwd = Tcl_GetStringFromObj(objv[i++], NULL);
02496 enc_flag = DB_ENCRYPT_AES;
02497 break;
02498 case TCL_DBREM_ENCRYPT_ANY:
02499
02500 if (i >= objc) {
02501 Tcl_WrongNumArgs(interp, 2, objv,
02502 "?-encryptany passwd?");
02503 result = TCL_ERROR;
02504 break;
02505 }
02506 passwd = Tcl_GetStringFromObj(objv[i++], NULL);
02507 enc_flag = 0;
02508 break;
02509 case TCL_DBREM_ENV:
02510 arg = Tcl_GetStringFromObj(objv[i++], NULL);
02511 envp = NAME_TO_ENV(arg);
02512 if (envp == NULL) {
02513 Tcl_SetResult(interp,
02514 "db remove: illegal environment",
02515 TCL_STATIC);
02516 return (TCL_ERROR);
02517 }
02518 break;
02519 case TCL_DBREM_ENDARG:
02520 endarg = 1;
02521 break;
02522 case TCL_DBREM_TXN:
02523 if (i >= objc) {
02524 Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?");
02525 result = TCL_ERROR;
02526 break;
02527 }
02528 arg = Tcl_GetStringFromObj(objv[i++], NULL);
02529 txn = NAME_TO_TXN(arg);
02530 if (txn == NULL) {
02531 snprintf(msg, MSG_SIZE,
02532 "Put: Invalid txn: %s\n", arg);
02533 Tcl_SetResult(interp, msg, TCL_VOLATILE);
02534 result = TCL_ERROR;
02535 }
02536 break;
02537 }
02538
02539
02540
02541
02542 if (result != TCL_OK)
02543 goto error;
02544 if (endarg)
02545 break;
02546 }
02547 if (result != TCL_OK)
02548 goto error;
02549
02550
02551
02552
02553 if ((i != (objc - 1)) || (i != (objc - 2))) {
02554
02555
02556
02557
02558
02559 db = Tcl_GetStringFromObj(objv[i++], NULL);
02560 if (strcmp(db, "") == 0)
02561 db = NULL;
02562 if (i != objc) {
02563 subdbtmp =
02564 Tcl_GetByteArrayFromObj(objv[i++], &subdblen);
02565 if ((ret = __os_malloc(envp, (size_t)subdblen + 1,
02566 &subdb)) != 0) { Tcl_SetResult(interp,
02567 db_strerror(ret), TCL_STATIC);
02568 return (0);
02569 }
02570 memcpy(subdb, subdbtmp, (size_t)subdblen);
02571 subdb[subdblen] = '\0';
02572 }
02573 } else {
02574 Tcl_WrongNumArgs(interp, 2, objv, "?args? filename ?database?");
02575 result = TCL_ERROR;
02576 goto error;
02577 }
02578 if (envp == NULL) {
02579 ret = db_create(&dbp, envp, 0);
02580 if (ret) {
02581 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
02582 "db_create");
02583 goto error;
02584 }
02585
02586 if (passwd != NULL) {
02587 ret = dbp->set_encrypt(dbp, passwd, enc_flag);
02588 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
02589 "set_encrypt");
02590 }
02591 if (set_flags != 0) {
02592 ret = dbp->set_flags(dbp, set_flags);
02593 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
02594 "set_flags");
02595 }
02596 }
02597
02598
02599
02600
02601 _debug_check();
02602 if (dbp == NULL)
02603 ret = envp->dbremove(envp, txn, db, subdb, iflags);
02604 else
02605 ret = dbp->remove(dbp, db, subdb, 0);
02606
02607 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db remove");
02608 dbp = NULL;
02609 error:
02610 if (subdb)
02611 __os_free(envp, subdb);
02612 if (result == TCL_ERROR && dbp != NULL)
02613 (void)dbp->close(dbp, 0);
02614 return (result);
02615 }
02616
02617
02618
02619
02620
02621 static int
02622 bdb_DbRename(interp, objc, objv)
02623 Tcl_Interp *interp;
02624 int objc;
02625 Tcl_Obj *CONST objv[];
02626 {
02627 static const char *bdbmv[] = {
02628 "-auto_commit",
02629 "-encrypt",
02630 "-encryptaes",
02631 "-encryptany",
02632 "-env",
02633 "-txn",
02634 "--",
02635 NULL
02636 };
02637 enum bdbmv {
02638 TCL_DBMV_AUTOCOMMIT,
02639 TCL_DBMV_ENCRYPT,
02640 TCL_DBMV_ENCRYPT_AES,
02641 TCL_DBMV_ENCRYPT_ANY,
02642 TCL_DBMV_ENV,
02643 TCL_DBMV_TXN,
02644 TCL_DBMV_ENDARG
02645 };
02646 DB *dbp;
02647 DB_ENV *envp;
02648 DB_TXN *txn;
02649 u_int32_t enc_flag, iflags, set_flags;
02650 int endarg, i, newlen, optindex, result, ret, subdblen;
02651 u_char *subdbtmp;
02652 char *arg, *db, msg[MSG_SIZE], *newname, *passwd, *subdb;
02653
02654 db = newname = subdb = NULL;
02655 dbp = NULL;
02656 endarg = 0;
02657 envp = NULL;
02658 iflags = enc_flag = set_flags = 0;
02659 passwd = NULL;
02660 result = TCL_OK;
02661 subdbtmp = NULL;
02662 txn = NULL;
02663
02664 if (objc < 2) {
02665 Tcl_WrongNumArgs(interp,
02666 3, objv, "?args? filename ?database? ?newname?");
02667 return (TCL_ERROR);
02668 }
02669
02670
02671
02672
02673
02674 i = 2;
02675 while (i < objc) {
02676 if (Tcl_GetIndexFromObj(interp, objv[i], bdbmv,
02677 "option", TCL_EXACT, &optindex) != TCL_OK) {
02678 arg = Tcl_GetStringFromObj(objv[i], NULL);
02679 if (arg[0] == '-') {
02680 result = IS_HELP(objv[i]);
02681 goto error;
02682 } else
02683 Tcl_ResetResult(interp);
02684 break;
02685 }
02686 i++;
02687 switch ((enum bdbmv)optindex) {
02688 case TCL_DBMV_AUTOCOMMIT:
02689 iflags |= DB_AUTO_COMMIT;
02690 _debug_check();
02691 break;
02692 case TCL_DBMV_ENCRYPT:
02693 set_flags |= DB_ENCRYPT;
02694 _debug_check();
02695 break;
02696 case TCL_DBMV_ENCRYPT_AES:
02697
02698 if (i >= objc) {
02699 Tcl_WrongNumArgs(interp, 2, objv,
02700 "?-encryptaes passwd?");
02701 result = TCL_ERROR;
02702 break;
02703 }
02704 passwd = Tcl_GetStringFromObj(objv[i++], NULL);
02705 enc_flag = DB_ENCRYPT_AES;
02706 break;
02707 case TCL_DBMV_ENCRYPT_ANY:
02708
02709 if (i >= objc) {
02710 Tcl_WrongNumArgs(interp, 2, objv,
02711 "?-encryptany passwd?");
02712 result = TCL_ERROR;
02713 break;
02714 }
02715 passwd = Tcl_GetStringFromObj(objv[i++], NULL);
02716 enc_flag = 0;
02717 break;
02718 case TCL_DBMV_ENV:
02719 arg = Tcl_GetStringFromObj(objv[i++], NULL);
02720 envp = NAME_TO_ENV(arg);
02721 if (envp == NULL) {
02722 Tcl_SetResult(interp,
02723 "db rename: illegal environment",
02724 TCL_STATIC);
02725 return (TCL_ERROR);
02726 }
02727 break;
02728 case TCL_DBMV_ENDARG:
02729 endarg = 1;
02730 break;
02731 case TCL_DBMV_TXN:
02732 if (i >= objc) {
02733 Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?");
02734 result = TCL_ERROR;
02735 break;
02736 }
02737 arg = Tcl_GetStringFromObj(objv[i++], NULL);
02738 txn = NAME_TO_TXN(arg);
02739 if (txn == NULL) {
02740 snprintf(msg, MSG_SIZE,
02741 "Put: Invalid txn: %s\n", arg);
02742 Tcl_SetResult(interp, msg, TCL_VOLATILE);
02743 result = TCL_ERROR;
02744 }
02745 break;
02746 }
02747
02748
02749
02750
02751 if (result != TCL_OK)
02752 goto error;
02753 if (endarg)
02754 break;
02755 }
02756 if (result != TCL_OK)
02757 goto error;
02758
02759
02760
02761
02762 if ((i != (objc - 2)) || (i != (objc - 3))) {
02763
02764
02765
02766
02767
02768 db = Tcl_GetStringFromObj(objv[i++], NULL);
02769 if (strcmp(db, "") == 0)
02770 db = NULL;
02771 if (i == objc - 2) {
02772 subdbtmp =
02773 Tcl_GetByteArrayFromObj(objv[i++], &subdblen);
02774 if ((ret = __os_malloc(envp, (size_t)subdblen + 1,
02775 &subdb)) != 0) {
02776 Tcl_SetResult(interp,
02777 db_strerror(ret), TCL_STATIC);
02778 return (0);
02779 }
02780 memcpy(subdb, subdbtmp, (size_t)subdblen);
02781 subdb[subdblen] = '\0';
02782 }
02783 subdbtmp =
02784 Tcl_GetByteArrayFromObj(objv[i++], &newlen);
02785 if ((ret = __os_malloc(envp, (size_t)newlen + 1,
02786 &newname)) != 0) {
02787 Tcl_SetResult(interp,
02788 db_strerror(ret), TCL_STATIC);
02789 return (0);
02790 }
02791 memcpy(newname, subdbtmp, (size_t)newlen);
02792 newname[newlen] = '\0';
02793 } else {
02794 Tcl_WrongNumArgs(
02795 interp, 3, objv, "?args? filename ?database? ?newname?");
02796 result = TCL_ERROR;
02797 goto error;
02798 }
02799 if (envp == NULL) {
02800 ret = db_create(&dbp, envp, 0);
02801 if (ret) {
02802 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
02803 "db_create");
02804 goto error;
02805 }
02806 if (passwd != NULL) {
02807 ret = dbp->set_encrypt(dbp, passwd, enc_flag);
02808 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
02809 "set_encrypt");
02810 }
02811 if (set_flags != 0) {
02812 ret = dbp->set_flags(dbp, set_flags);
02813 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
02814 "set_flags");
02815 }
02816 }
02817
02818
02819
02820
02821 _debug_check();
02822 if (dbp == NULL)
02823 ret = envp->dbrename(envp, txn, db, subdb, newname, iflags);
02824 else
02825 ret = dbp->rename(dbp, db, subdb, newname, 0);
02826 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db rename");
02827 dbp = NULL;
02828 error:
02829 if (subdb)
02830 __os_free(envp, subdb);
02831 if (newname)
02832 __os_free(envp, newname);
02833 if (result == TCL_ERROR && dbp != NULL)
02834 (void)dbp->close(dbp, 0);
02835 return (result);
02836 }
02837
02838 #ifdef CONFIG_TEST
02839
02840
02841
02842
02843 static int
02844 bdb_DbVerify(interp, objc, objv)
02845 Tcl_Interp *interp;
02846 int objc;
02847 Tcl_Obj *CONST objv[];
02848 {
02849 static const char *bdbverify[] = {
02850 "-encrypt",
02851 "-encryptaes",
02852 "-encryptany",
02853 "-env",
02854 "-errfile",
02855 "-errpfx",
02856 "-unref",
02857 "--",
02858 NULL
02859 };
02860 enum bdbvrfy {
02861 TCL_DBVRFY_ENCRYPT,
02862 TCL_DBVRFY_ENCRYPT_AES,
02863 TCL_DBVRFY_ENCRYPT_ANY,
02864 TCL_DBVRFY_ENV,
02865 TCL_DBVRFY_ERRFILE,
02866 TCL_DBVRFY_ERRPFX,
02867 TCL_DBVRFY_UNREF,
02868 TCL_DBVRFY_ENDARG
02869 };
02870 DB_ENV *envp;
02871 DB *dbp;
02872 FILE *errf;
02873 u_int32_t enc_flag, flags, set_flags;
02874 int endarg, i, optindex, result, ret;
02875 char *arg, *db, *errpfx, *passwd;
02876
02877 envp = NULL;
02878 dbp = NULL;
02879 passwd = NULL;
02880 result = TCL_OK;
02881 db = errpfx = NULL;
02882 errf = NULL;
02883 flags = endarg = 0;
02884 enc_flag = set_flags = 0;
02885
02886 if (objc < 2) {
02887 Tcl_WrongNumArgs(interp, 2, objv, "?args? filename");
02888 return (TCL_ERROR);
02889 }
02890
02891
02892
02893
02894
02895 i = 2;
02896 while (i < objc) {
02897 if (Tcl_GetIndexFromObj(interp, objv[i], bdbverify,
02898 "option", TCL_EXACT, &optindex) != TCL_OK) {
02899 arg = Tcl_GetStringFromObj(objv[i], NULL);
02900 if (arg[0] == '-') {
02901 result = IS_HELP(objv[i]);
02902 goto error;
02903 } else
02904 Tcl_ResetResult(interp);
02905 break;
02906 }
02907 i++;
02908 switch ((enum bdbvrfy)optindex) {
02909 case TCL_DBVRFY_ENCRYPT:
02910 set_flags |= DB_ENCRYPT;
02911 _debug_check();
02912 break;
02913 case TCL_DBVRFY_ENCRYPT_AES:
02914
02915 if (i >= objc) {
02916 Tcl_WrongNumArgs(interp, 2, objv,
02917 "?-encryptaes passwd?");
02918 result = TCL_ERROR;
02919 break;
02920 }
02921 passwd = Tcl_GetStringFromObj(objv[i++], NULL);
02922 enc_flag = DB_ENCRYPT_AES;
02923 break;
02924 case TCL_DBVRFY_ENCRYPT_ANY:
02925
02926 if (i >= objc) {
02927 Tcl_WrongNumArgs(interp, 2, objv,
02928 "?-encryptany passwd?");
02929 result = TCL_ERROR;
02930 break;
02931 }
02932 passwd = Tcl_GetStringFromObj(objv[i++], NULL);
02933 enc_flag = 0;
02934 break;
02935 case TCL_DBVRFY_ENV:
02936 arg = Tcl_GetStringFromObj(objv[i++], NULL);
02937 envp = NAME_TO_ENV(arg);
02938 if (envp == NULL) {
02939 Tcl_SetResult(interp,
02940 "db verify: illegal environment",
02941 TCL_STATIC);
02942 result = TCL_ERROR;
02943 break;
02944 }
02945 break;
02946 case TCL_DBVRFY_ERRFILE:
02947 if (i >= objc) {
02948 Tcl_WrongNumArgs(interp, 2, objv,
02949 "-errfile file");
02950 result = TCL_ERROR;
02951 break;
02952 }
02953 arg = Tcl_GetStringFromObj(objv[i++], NULL);
02954
02955
02956
02957 if (errf != NULL && errf != stdout && errf != stderr)
02958 (void)fclose(errf);
02959 if (strcmp(arg, "/dev/stdout") == 0)
02960 errf = stdout;
02961 else if (strcmp(arg, "/dev/stderr") == 0)
02962 errf = stderr;
02963 else
02964 errf = fopen(arg, "a");
02965 break;
02966 case TCL_DBVRFY_ERRPFX:
02967 if (i >= objc) {
02968 Tcl_WrongNumArgs(interp, 2, objv,
02969 "-errpfx prefix");
02970 result = TCL_ERROR;
02971 break;
02972 }
02973 arg = Tcl_GetStringFromObj(objv[i++], NULL);
02974
02975
02976
02977 if (errpfx != NULL)
02978 __os_free(envp, errpfx);
02979 if ((ret = __os_strdup(NULL, arg, &errpfx)) != 0) {
02980 result = _ReturnSetup(interp, ret,
02981 DB_RETOK_STD(ret), "__os_strdup");
02982 break;
02983 }
02984 break;
02985 case TCL_DBVRFY_UNREF:
02986 flags |= DB_UNREF;
02987 break;
02988 case TCL_DBVRFY_ENDARG:
02989 endarg = 1;
02990 break;
02991 }
02992
02993
02994
02995
02996 if (result != TCL_OK)
02997 goto error;
02998 if (endarg)
02999 break;
03000 }
03001 if (result != TCL_OK)
03002 goto error;
03003
03004
03005
03006 if (i == (objc - 1))
03007 db = Tcl_GetStringFromObj(objv[i++], NULL);
03008 else {
03009 Tcl_WrongNumArgs(interp, 2, objv, "?args? filename");
03010 result = TCL_ERROR;
03011 goto error;
03012 }
03013 ret = db_create(&dbp, envp, 0);
03014 if (ret) {
03015 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
03016 "db_create");
03017 goto error;
03018 }
03019
03020 if (passwd != NULL) {
03021 ret = dbp->set_encrypt(dbp, passwd, enc_flag);
03022 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
03023 "set_encrypt");
03024 }
03025
03026 if (set_flags != 0) {
03027 ret = dbp->set_flags(dbp, set_flags);
03028 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
03029 "set_flags");
03030 }
03031 if (errf != NULL)
03032 dbp->set_errfile(dbp, errf);
03033 if (errpfx != NULL)
03034 dbp->set_errpfx(dbp, errpfx);
03035
03036
03037
03038
03039 ret = dbp->verify(dbp, db, NULL, NULL, flags);
03040 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db verify");
03041 dbp = NULL;
03042 error:
03043 if (errf != NULL && errf != stdout && errf != stderr)
03044 (void)fclose(errf);
03045 if (errpfx != NULL)
03046 __os_free(envp, errpfx);
03047 if (dbp)
03048 (void)dbp->close(dbp, 0);
03049 return (result);
03050 }
03051 #endif
03052
03053
03054
03055
03056
03057 static int
03058 bdb_Version(interp, objc, objv)
03059 Tcl_Interp *interp;
03060 int objc;
03061 Tcl_Obj *CONST objv[];
03062 {
03063 static const char *bdbver[] = {
03064 "-string", NULL
03065 };
03066 enum bdbver {
03067 TCL_VERSTRING
03068 };
03069 int i, optindex, maj, min, patch, result, string, verobjc;
03070 char *arg, *v;
03071 Tcl_Obj *res, *verobjv[3];
03072
03073 result = TCL_OK;
03074 string = 0;
03075
03076 if (objc < 2) {
03077 Tcl_WrongNumArgs(interp, 2, objv, "?args?");
03078 return (TCL_ERROR);
03079 }
03080
03081
03082
03083
03084
03085 i = 2;
03086 while (i < objc) {
03087 if (Tcl_GetIndexFromObj(interp, objv[i], bdbver,
03088 "option", TCL_EXACT, &optindex) != TCL_OK) {
03089 arg = Tcl_GetStringFromObj(objv[i], NULL);
03090 if (arg[0] == '-') {
03091 result = IS_HELP(objv[i]);
03092 goto error;
03093 } else
03094 Tcl_ResetResult(interp);
03095 break;
03096 }
03097 i++;
03098 switch ((enum bdbver)optindex) {
03099 case TCL_VERSTRING:
03100 string = 1;
03101 break;
03102 }
03103
03104
03105
03106
03107 if (result != TCL_OK)
03108 goto error;
03109 }
03110 if (result != TCL_OK)
03111 goto error;
03112
03113 v = db_version(&maj, &min, &patch);
03114 if (string)
03115 res = NewStringObj(v, strlen(v));
03116 else {
03117 verobjc = 3;
03118 verobjv[0] = Tcl_NewIntObj(maj);
03119 verobjv[1] = Tcl_NewIntObj(min);
03120 verobjv[2] = Tcl_NewIntObj(patch);
03121 res = Tcl_NewListObj(verobjc, verobjv);
03122 }
03123 Tcl_SetObjResult(interp, res);
03124 error:
03125 return (result);
03126 }
03127
03128 #ifdef CONFIG_TEST
03129
03130
03131
03132
03133 static int
03134 bdb_Handles(interp, objc, objv)
03135 Tcl_Interp *interp;
03136 int objc;
03137 Tcl_Obj *CONST objv[];
03138 {
03139 DBTCL_INFO *p;
03140 Tcl_Obj *res, *handle;
03141
03142
03143
03144
03145 if (objc != 2) {
03146 Tcl_WrongNumArgs(interp, 2, objv, "");
03147 return (TCL_ERROR);
03148 }
03149 res = Tcl_NewListObj(0, NULL);
03150
03151 for (p = LIST_FIRST(&__db_infohead); p != NULL;
03152 p = LIST_NEXT(p, entries)) {
03153 handle = NewStringObj(p->i_name, strlen(p->i_name));
03154 if (Tcl_ListObjAppendElement(interp, res, handle) != TCL_OK)
03155 return (TCL_ERROR);
03156 }
03157 Tcl_SetObjResult(interp, res);
03158 return (TCL_OK);
03159 }
03160
03161
03162
03163
03164
03165
03166 static int
03167 bdb_MsgType(interp, objc, objv)
03168 Tcl_Interp *interp;
03169 int objc;
03170 Tcl_Obj *CONST objv[];
03171 {
03172 REP_CONTROL *rp;
03173 Tcl_Obj *msgname;
03174 u_int32_t len, msgtype;
03175 int freerp, ret;
03176
03177
03178
03179
03180
03181 static const char *msgnames[] = {
03182 "no_type", "alive", "alive_req", "all_req",
03183 "dupmaster", "file", "file_fail", "file_req", "log",
03184 "log_more", "log_req", "master_req", "newclient",
03185 "newfile", "newmaster", "newsite", "page",
03186 "page_fail", "page_req", "update", "update_req",
03187 "verify", "verify_fail", "verify_req",
03188 "vote1", "vote2", NULL
03189 };
03190
03191
03192
03193
03194 if (objc != 3) {
03195 Tcl_WrongNumArgs(interp, 3, objv, "msgtype msg");
03196 return (TCL_ERROR);
03197 }
03198
03199 ret = _CopyObjBytes(interp, objv[2], &rp, &len, &freerp);
03200 if (ret != TCL_OK) {
03201 Tcl_SetResult(interp,
03202 "msgtype: bad control message", TCL_STATIC);
03203 return (TCL_ERROR);
03204 }
03205 msgtype = rp->rectype;
03206 msgname = NewStringObj(msgnames[msgtype], strlen(msgnames[msgtype]));
03207 Tcl_SetObjResult(interp, msgname);
03208 if (rp != NULL && freerp)
03209 __os_free(NULL, rp);
03210 return (TCL_OK);
03211 }
03212
03213
03214
03215
03216
03217 static int
03218 bdb_DbUpgrade(interp, objc, objv)
03219 Tcl_Interp *interp;
03220 int objc;
03221 Tcl_Obj *CONST objv[];
03222 {
03223 static const char *bdbupg[] = {
03224 "-dupsort", "-env", "--", NULL
03225 };
03226 enum bdbupg {
03227 TCL_DBUPG_DUPSORT,
03228 TCL_DBUPG_ENV,
03229 TCL_DBUPG_ENDARG
03230 };
03231 DB_ENV *envp;
03232 DB *dbp;
03233 u_int32_t flags;
03234 int endarg, i, optindex, result, ret;
03235 char *arg, *db;
03236
03237 envp = NULL;
03238 dbp = NULL;
03239 result = TCL_OK;
03240 db = NULL;
03241 flags = endarg = 0;
03242
03243 if (objc < 2) {
03244 Tcl_WrongNumArgs(interp, 2, objv, "?args? filename");
03245 return (TCL_ERROR);
03246 }
03247
03248 i = 2;
03249 while (i < objc) {
03250 if (Tcl_GetIndexFromObj(interp, objv[i], bdbupg,
03251 "option", TCL_EXACT, &optindex) != TCL_OK) {
03252 arg = Tcl_GetStringFromObj(objv[i], NULL);
03253 if (arg[0] == '-') {
03254 result = IS_HELP(objv[i]);
03255 goto error;
03256 } else
03257 Tcl_ResetResult(interp);
03258 break;
03259 }
03260 i++;
03261 switch ((enum bdbupg)optindex) {
03262 case TCL_DBUPG_DUPSORT:
03263 flags |= DB_DUPSORT;
03264 break;
03265 case TCL_DBUPG_ENV:
03266 arg = Tcl_GetStringFromObj(objv[i++], NULL);
03267 envp = NAME_TO_ENV(arg);
03268 if (envp == NULL) {
03269 Tcl_SetResult(interp,
03270 "db upgrade: illegal environment",
03271 TCL_STATIC);
03272 return (TCL_ERROR);
03273 }
03274 break;
03275 case TCL_DBUPG_ENDARG:
03276 endarg = 1;
03277 break;
03278 }
03279
03280
03281
03282
03283 if (result != TCL_OK)
03284 goto error;
03285 if (endarg)
03286 break;
03287 }
03288 if (result != TCL_OK)
03289 goto error;
03290
03291
03292
03293 if (i == (objc - 1))
03294 db = Tcl_GetStringFromObj(objv[i++], NULL);
03295 else {
03296 Tcl_WrongNumArgs(interp, 2, objv, "?args? filename");
03297 result = TCL_ERROR;
03298 goto error;
03299 }
03300 ret = db_create(&dbp, envp, 0);
03301 if (ret) {
03302 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
03303 "db_create");
03304 goto error;
03305 }
03306
03307 ret = dbp->upgrade(dbp, db, flags);
03308 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db upgrade");
03309 error:
03310 if (dbp)
03311 (void)dbp->close(dbp, 0);
03312 return (result);
03313 }
03314
03315
03316
03317
03318
03319
03320
03321 static int
03322 tcl_bt_compare(dbp, dbta, dbtb)
03323 DB *dbp;
03324 const DBT *dbta, *dbtb;
03325 {
03326 return (tcl_compare_callback(dbp, dbta, dbtb,
03327 ((DBTCL_INFO *)dbp->api_internal)->i_btcompare, "bt_compare"));
03328 }
03329
03330 static int
03331 tcl_dup_compare(dbp, dbta, dbtb)
03332 DB *dbp;
03333 const DBT *dbta, *dbtb;
03334 {
03335 return (tcl_compare_callback(dbp, dbta, dbtb,
03336 ((DBTCL_INFO *)dbp->api_internal)->i_dupcompare, "dup_compare"));
03337 }
03338
03339
03340
03341
03342
03343
03344
03345
03346 static int
03347 tcl_compare_callback(dbp, dbta, dbtb, procobj, errname)
03348 DB *dbp;
03349 const DBT *dbta, *dbtb;
03350 Tcl_Obj *procobj;
03351 char *errname;
03352 {
03353 DBTCL_INFO *ip;
03354 Tcl_Interp *interp;
03355 Tcl_Obj *a, *b, *resobj, *objv[3];
03356 int result, cmp;
03357
03358 ip = (DBTCL_INFO *)dbp->api_internal;
03359 interp = ip->i_interp;
03360 objv[0] = procobj;
03361
03362
03363
03364
03365
03366
03367 a = Tcl_NewByteArrayObj(dbta->data, (int)dbta->size);
03368 Tcl_IncrRefCount(a);
03369 b = Tcl_NewByteArrayObj(dbtb->data, (int)dbtb->size);
03370 Tcl_IncrRefCount(b);
03371
03372 objv[1] = a;
03373 objv[2] = b;
03374
03375 result = Tcl_EvalObjv(interp, 3, objv, 0);
03376 if (result != TCL_OK) {
03377
03378
03379
03380
03381
03382
03383
03384
03385
03386
03387
03388
03389
03390
03391
03392 panic: __db_err(dbp->dbenv, "Tcl %s callback failed", errname);
03393 return (__db_panic(dbp->dbenv, DB_RUNRECOVERY));
03394 }
03395
03396 resobj = Tcl_GetObjResult(interp);
03397 result = Tcl_GetIntFromObj(interp, resobj, &cmp);
03398 if (result != TCL_OK)
03399 goto panic;
03400
03401 Tcl_DecrRefCount(a);
03402 Tcl_DecrRefCount(b);
03403 return (cmp);
03404 }
03405
03406
03407
03408
03409
03410
03411
03412 static u_int32_t
03413 tcl_h_hash(dbp, buf, len)
03414 DB *dbp;
03415 const void *buf;
03416 u_int32_t len;
03417 {
03418 DBTCL_INFO *ip;
03419 Tcl_Interp *interp;
03420 Tcl_Obj *objv[2];
03421 int result, hval;
03422
03423 ip = (DBTCL_INFO *)dbp->api_internal;
03424 interp = ip->i_interp;
03425 objv[0] = ip->i_hashproc;
03426
03427
03428
03429
03430 objv[1] = Tcl_NewByteArrayObj((void *)buf, (int)len);
03431 Tcl_IncrRefCount(objv[1]);
03432 result = Tcl_EvalObjv(interp, 2, objv, 0);
03433 if (result != TCL_OK)
03434 goto panic;
03435
03436 result = Tcl_GetIntFromObj(interp, Tcl_GetObjResult(interp), &hval);
03437 if (result != TCL_OK)
03438 goto panic;
03439
03440 Tcl_DecrRefCount(objv[1]);
03441 return ((u_int32_t)hval);
03442
03443 panic:
03444
03445
03446
03447 __db_err(dbp->dbenv, "Tcl h_hash callback failed");
03448 (void)__db_panic(dbp->dbenv, DB_RUNRECOVERY);
03449
03450 DB_ASSERT(0);
03451
03452
03453 return (0);
03454 }
03455
03456
03457
03458
03459
03460
03461
03462
03463 int
03464 tcl_rep_send(dbenv, control, rec, lsnp, eid, flags)
03465 DB_ENV *dbenv;
03466 const DBT *control, *rec;
03467 const DB_LSN *lsnp;
03468 int eid;
03469 u_int32_t flags;
03470 {
03471 #define TCLDB_SENDITEMS 7
03472 #define TCLDB_MAXREPFLAGS 32
03473 DBTCL_INFO *ip;
03474 Tcl_Interp *interp;
03475 Tcl_Obj *control_o, *eid_o, *flags_o, *lsn_o, *origobj, *rec_o;
03476 Tcl_Obj *lsnobj[2], *myobjv[TCLDB_MAXREPFLAGS], *objv[TCLDB_SENDITEMS];
03477 Tcl_Obj *resobj;
03478 int i, myobjc, result, ret;
03479
03480 ip = (DBTCL_INFO *)dbenv->app_private;
03481 interp = ip->i_interp;
03482 objv[0] = ip->i_rep_send;
03483
03484 control_o = Tcl_NewByteArrayObj(control->data, (int)control->size);
03485 Tcl_IncrRefCount(control_o);
03486
03487 rec_o = Tcl_NewByteArrayObj(rec->data, (int)rec->size);
03488 Tcl_IncrRefCount(rec_o);
03489
03490 eid_o = Tcl_NewIntObj(eid);
03491 Tcl_IncrRefCount(eid_o);
03492
03493 myobjv[myobjc = 0] = NULL;
03494 if (flags == 0)
03495 myobjv[myobjc++] = NewStringObj("none", strlen("none"));
03496 if (LF_ISSET(DB_REP_ANYWHERE))
03497 myobjv[myobjc++] = NewStringObj("any", strlen("any"));
03498 if (LF_ISSET(DB_REP_NOBUFFER))
03499 myobjv[myobjc++] = NewStringObj("nobuffer", strlen("nobuffer"));
03500 if (LF_ISSET(DB_REP_PERMANENT))
03501 myobjv[myobjc++] = NewStringObj("perm", strlen("perm"));
03502 if (LF_ISSET(DB_REP_REREQUEST))
03503 myobjv[myobjc++] =
03504 NewStringObj("rerequest", strlen("rerequest"));
03505
03506
03507
03508 if (myobjc == 0)
03509 myobjv[myobjc++] = NewStringObj("unknown", strlen("unknown"));
03510 for (i = 0; i < myobjc; i++)
03511 Tcl_IncrRefCount(myobjv[i]);
03512 flags_o = Tcl_NewListObj(myobjc, myobjv);
03513 Tcl_IncrRefCount(flags_o);
03514
03515 lsnobj[0] = Tcl_NewLongObj((long)lsnp->file);
03516 Tcl_IncrRefCount(lsnobj[0]);
03517 lsnobj[1] = Tcl_NewLongObj((long)lsnp->offset);
03518 Tcl_IncrRefCount(lsnobj[1]);
03519 lsn_o = Tcl_NewListObj(2, lsnobj);
03520 Tcl_IncrRefCount(lsn_o);
03521
03522 objv[1] = control_o;
03523 objv[2] = rec_o;
03524 objv[3] = ip->i_rep_eid;
03525 objv[4] = eid_o;
03526 objv[5] = flags_o;
03527 objv[6] = lsn_o;
03528
03529
03530
03531
03532
03533
03534
03535 origobj = Tcl_GetObjResult(interp);
03536 Tcl_IncrRefCount(origobj);
03537 result = Tcl_EvalObjv(interp, TCLDB_SENDITEMS, objv, 0);
03538 if (result != TCL_OK) {
03539
03540
03541
03542
03543
03544
03545 err: __db_err(dbenv, "Tcl rep_send failure");
03546 return (EINVAL);
03547 }
03548
03549 resobj = Tcl_GetObjResult(interp);
03550 result = Tcl_GetIntFromObj(interp, resobj, &ret);
03551 if (result != TCL_OK)
03552 goto err;
03553
03554 Tcl_SetObjResult(interp, origobj);
03555 Tcl_DecrRefCount(origobj);
03556 Tcl_DecrRefCount(control_o);
03557 Tcl_DecrRefCount(rec_o);
03558 Tcl_DecrRefCount(eid_o);
03559 for (i = 0; i < myobjc; i++)
03560 Tcl_DecrRefCount(myobjv[i]);
03561 Tcl_DecrRefCount(flags_o);
03562 Tcl_DecrRefCount(lsnobj[0]);
03563 Tcl_DecrRefCount(lsnobj[1]);
03564 Tcl_DecrRefCount(lsn_o);
03565
03566 return (ret);
03567 }
03568 #endif
03569
03570 #ifdef CONFIG_TEST
03571
03572
03573
03574
03575
03576
03577 static void *
03578 tcl_db_malloc(size)
03579 size_t size;
03580 {
03581 Tcl_Obj *obj;
03582 void *buf;
03583
03584 obj = Tcl_NewObj();
03585 if (obj == NULL)
03586 return (NULL);
03587 Tcl_IncrRefCount(obj);
03588
03589 Tcl_SetObjLength(obj, (int)(size + sizeof(Tcl_Obj *)));
03590 buf = Tcl_GetString(obj);
03591 memcpy(buf, &obj, sizeof(&obj));
03592
03593 buf = (Tcl_Obj **)buf + 1;
03594 return (buf);
03595 }
03596
03597 static void *
03598 tcl_db_realloc(ptr, size)
03599 void *ptr;
03600 size_t size;
03601 {
03602 Tcl_Obj *obj;
03603
03604 if (ptr == NULL)
03605 return (tcl_db_malloc(size));
03606
03607 obj = *(Tcl_Obj **)((Tcl_Obj **)ptr - 1);
03608 Tcl_SetObjLength(obj, (int)(size + sizeof(Tcl_Obj *)));
03609
03610 ptr = Tcl_GetString(obj);
03611 memcpy(ptr, &obj, sizeof(&obj));
03612
03613 ptr = (Tcl_Obj **)ptr + 1;
03614 return (ptr);
03615 }
03616
03617 static void
03618 tcl_db_free(ptr)
03619 void *ptr;
03620 {
03621 Tcl_Obj *obj;
03622
03623 obj = *(Tcl_Obj **)((Tcl_Obj **)ptr - 1);
03624 Tcl_DecrRefCount(obj);
03625 }
03626 #endif
