#include "db_config.h"
#ifdef CONFIG_TEST
#define DB_DBM_HSEARCH 1
#endif
#include "db_int.h"
#ifdef HAVE_SYSTEM_INCLUDE_FILES
#include <tcl.h>
#endif
#include "dbinc/db_page.h"
#include "dbinc/hash.h"
#include "dbinc/tcl_db.h"
DBTCL_GLOBAL __dbtcl_global;
static int berkdb_Cmd __P((ClientData, Tcl_Interp *, int,
Tcl_Obj * CONST*));
static int bdb_EnvOpen __P((Tcl_Interp *, int, Tcl_Obj * CONST*,
DBTCL_INFO *, DB_ENV **));
static int bdb_DbOpen __P((Tcl_Interp *, int, Tcl_Obj * CONST*,
DBTCL_INFO *, DB **));
static int bdb_DbRemove __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
static int bdb_DbRename __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
static int bdb_Version __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
#ifdef HAVE_64BIT_TYPES
static int bdb_SeqOpen __P((Tcl_Interp *, int, Tcl_Obj * CONST*,
DBTCL_INFO *, DB_SEQUENCE **));
#endif
#ifdef CONFIG_TEST
static int bdb_DbUpgrade __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
static int bdb_DbVerify __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
static int bdb_GetConfig __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
static int bdb_Handles __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
static int bdb_MsgType __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
static int tcl_bt_compare __P((DB *, const DBT *, const DBT *));
static int tcl_compare_callback __P((DB *, const DBT *, const DBT *,
Tcl_Obj *, char *));
static void tcl_db_free __P((void *));
static void * tcl_db_malloc __P((size_t));
static void * tcl_db_realloc __P((void *, size_t));
static int tcl_dup_compare __P((DB *, const DBT *, const DBT *));
static u_int32_t tcl_h_hash __P((DB *, const void *, u_int32_t));
#endif
int
Db_tcl_Init(interp)
Tcl_Interp *interp;
{
int code;
char pkg[12];
snprintf(pkg, sizeof(pkg), "%d.%d", DB_VERSION_MAJOR, DB_VERSION_MINOR);
code = Tcl_PkgProvide(interp, "Db_tcl", pkg);
if (code != TCL_OK)
return (code);
(void)Tcl_CreateObjCommand(interp,
"berkdb", (Tcl_ObjCmdProc *)berkdb_Cmd, (ClientData)0, NULL);
(void)Tcl_LinkVar(
interp, "__debug_on", (char *)&__debug_on, TCL_LINK_INT);
(void)Tcl_LinkVar(
interp, "__debug_print", (char *)&__debug_print, TCL_LINK_INT);
(void)Tcl_LinkVar(
interp, "__debug_stop", (char *)&__debug_stop, TCL_LINK_INT);
(void)Tcl_LinkVar(
interp, "__debug_test", (char *)&__debug_test,
TCL_LINK_INT);
LIST_INIT(&__db_infohead);
return (TCL_OK);
}
static int
berkdb_Cmd(notused, interp, objc, objv)
ClientData notused;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
static const char *berkdbcmds[] = {
#ifdef CONFIG_TEST
"dbverify",
"getconfig",
"handles",
"msgtype",
"upgrade",
#endif
"dbremove",
"dbrename",
"env",
"envremove",
"open",
#ifdef HAVE_64BIT_TYPES
"sequence",
#endif
"version",
#ifdef CONFIG_TEST
"hcreate", "hsearch", "hdestroy",
"dbminit", "fetch", "store",
"delete", "firstkey", "nextkey",
"ndbm_open", "dbmclose",
#endif
"rand", "random_int", "srand",
"debug_check",
NULL
};
enum berkdbcmds {
#ifdef CONFIG_TEST
BDB_DBVERIFY,
BDB_GETCONFIG,
BDB_HANDLES,
BDB_MSGTYPE,
BDB_UPGRADE,
#endif
BDB_DBREMOVE,
BDB_DBRENAME,
BDB_ENV,
BDB_ENVREMOVE,
BDB_OPEN,
#ifdef HAVE_64BIT_TYPES
BDB_SEQUENCE,
#endif
BDB_VERSION,
#ifdef CONFIG_TEST
BDB_HCREATEX, BDB_HSEARCHX, BDB_HDESTROYX,
BDB_DBMINITX, BDB_FETCHX, BDB_STOREX,
BDB_DELETEX, BDB_FIRSTKEYX, BDB_NEXTKEYX,
BDB_NDBMOPENX, BDB_DBMCLOSEX,
#endif
BDB_RANDX, BDB_RAND_INTX, BDB_SRANDX,
BDB_DBGCKX
};
static int env_id = 0;
static int db_id = 0;
#ifdef HAVE_64BIT_TYPES
static int seq_id = 0;
#endif
DB *dbp;
#ifdef HAVE_64BIT_TYPES
DB_SEQUENCE *seq;
#endif
#ifdef CONFIG_TEST
DBM *ndbmp;
static int ndbm_id = 0;
#endif
DBTCL_INFO *ip;
DB_ENV *envp;
Tcl_Obj *res;
int cmdindex, result;
char newname[MSG_SIZE];
COMPQUIET(notused, NULL);
Tcl_ResetResult(interp);
memset(newname, 0, MSG_SIZE);
result = TCL_OK;
if (objc <= 1) {
Tcl_WrongNumArgs(interp, 1, objv, "command cmdargs");
return (TCL_ERROR);
}
if (Tcl_GetIndexFromObj(interp,
objv[1], berkdbcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
return (IS_HELP(objv[1]));
res = NULL;
switch ((enum berkdbcmds)cmdindex) {
#ifdef CONFIG_TEST
case BDB_DBVERIFY:
result = bdb_DbVerify(interp, objc, objv);
break;
case BDB_GETCONFIG:
result = bdb_GetConfig(interp, objc, objv);
break;
case BDB_HANDLES:
result = bdb_Handles(interp, objc, objv);
break;
case BDB_MSGTYPE:
result = bdb_MsgType(interp, objc, objv);
break;
case BDB_UPGRADE:
result = bdb_DbUpgrade(interp, objc, objv);
break;
#endif
case BDB_VERSION:
_debug_check();
result = bdb_Version(interp, objc, objv);
break;
case BDB_ENV:
snprintf(newname, sizeof(newname), "env%d", env_id);
ip = _NewInfo(interp, NULL, newname, I_ENV);
if (ip != NULL) {
result = bdb_EnvOpen(interp, objc, objv, ip, &envp);
if (result == TCL_OK && envp != NULL) {
env_id++;
(void)Tcl_CreateObjCommand(interp, newname,
(Tcl_ObjCmdProc *)env_Cmd,
(ClientData)envp, NULL);
res = NewStringObj(newname, strlen(newname));
_SetInfoData(ip, envp);
} else
_DeleteInfo(ip);
} else {
Tcl_SetResult(interp, "Could not set up info",
TCL_STATIC);
result = TCL_ERROR;
}
break;
case BDB_DBREMOVE:
result = bdb_DbRemove(interp, objc, objv);
break;
case BDB_DBRENAME:
result = bdb_DbRename(interp, objc, objv);
break;
case BDB_ENVREMOVE:
result = tcl_EnvRemove(interp, objc, objv, NULL, NULL);
break;
case BDB_OPEN:
snprintf(newname, sizeof(newname), "db%d", db_id);
ip = _NewInfo(interp, NULL, newname, I_DB);
if (ip != NULL) {
result = bdb_DbOpen(interp, objc, objv, ip, &dbp);
if (result == TCL_OK && dbp != NULL) {
db_id++;
(void)Tcl_CreateObjCommand(interp, newname,
(Tcl_ObjCmdProc *)db_Cmd,
(ClientData)dbp, NULL);
res = NewStringObj(newname, strlen(newname));
_SetInfoData(ip, dbp);
} else
_DeleteInfo(ip);
} else {
Tcl_SetResult(interp, "Could not set up info",
TCL_STATIC);
result = TCL_ERROR;
}
break;
#ifdef HAVE_64BIT_TYPES
case BDB_SEQUENCE:
snprintf(newname, sizeof(newname), "seq%d", seq_id);
ip = _NewInfo(interp, NULL, newname, I_SEQ);
if (ip != NULL) {
result = bdb_SeqOpen(interp, objc, objv, ip, &seq);
if (result == TCL_OK && seq != NULL) {
seq_id++;
(void)Tcl_CreateObjCommand(interp, newname,
(Tcl_ObjCmdProc *)seq_Cmd,
(ClientData)seq, NULL);
res = NewStringObj(newname, strlen(newname));
_SetInfoData(ip, seq);
} else
_DeleteInfo(ip);
} else {
Tcl_SetResult(interp, "Could not set up info",
TCL_STATIC);
result = TCL_ERROR;
}
break;
#endif
#ifdef CONFIG_TEST
case BDB_HCREATEX:
case BDB_HSEARCHX:
case BDB_HDESTROYX:
result = bdb_HCommand(interp, objc, objv);
break;
case BDB_DBMINITX:
case BDB_DBMCLOSEX:
case BDB_FETCHX:
case BDB_STOREX:
case BDB_DELETEX:
case BDB_FIRSTKEYX:
case BDB_NEXTKEYX:
result = bdb_DbmCommand(interp, objc, objv, DBTCL_DBM, NULL);
break;
case BDB_NDBMOPENX:
snprintf(newname, sizeof(newname), "ndbm%d", ndbm_id);
ip = _NewInfo(interp, NULL, newname, I_NDBM);
if (ip != NULL) {
result = bdb_NdbmOpen(interp, objc, objv, &ndbmp);
if (result == TCL_OK) {
ndbm_id++;
(void)Tcl_CreateObjCommand(interp, newname,
(Tcl_ObjCmdProc *)ndbm_Cmd,
(ClientData)ndbmp, NULL);
res = NewStringObj(newname, strlen(newname));
_SetInfoData(ip, ndbmp);
} else
_DeleteInfo(ip);
} else {
Tcl_SetResult(interp, "Could not set up info",
TCL_STATIC);
result = TCL_ERROR;
}
break;
#endif
case BDB_RANDX:
case BDB_RAND_INTX:
case BDB_SRANDX:
result = bdb_RandCommand(interp, objc, objv);
break;
case BDB_DBGCKX:
_debug_check();
res = Tcl_NewIntObj(0);
break;
}
if (result == TCL_OK && res != NULL)
Tcl_SetObjResult(interp, res);
return (result);
}
static int
bdb_EnvOpen(interp, objc, objv, ip, env)
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
DBTCL_INFO *ip;
DB_ENV **env;
{
static const char *envopen[] = {
#ifdef CONFIG_TEST
"-alloc",
"-auto_commit",
"-cdb",
"-cdb_alldb",
"-client_timeout",
"-event",
"-lock",
"-lock_conflict",
"-lock_detect",
"-lock_max_locks",
"-lock_max_lockers",
"-lock_max_objects",
"-lock_timeout",
"-log",
"-log_filemode",
"-log_buffer",
"-log_inmemory",
"-log_max",
"-log_regionmax",
"-log_remove",
"-mpool_max_openfd",
"-mpool_max_write",
"-mpool_mmap_size",
"-mpool_nommap",
"-multiversion",
"-overwrite",
"-region_init",
"-rep",
"-rep_client",
"-rep_lease",
"-rep_master",
"-rep_transport",
"-server",
"-server_timeout",
"-set_intermediate_dir",
"-snapshot",
"-thread",
"-time_notgranted",
"-txn_nowait",
"-txn_timeout",
"-txn_timestamp",
"-verbose",
"-wrnosync",
#endif
"-cachesize",
"-cache_max",
"-create",
"-data_dir",
"-encryptaes",
"-encryptany",
"-errfile",
"-errpfx",
"-home",
"-log_dir",
"-mode",
"-private",
"-recover",
"-recover_fatal",
"-register",
"-shm_key",
"-system_mem",
"-tmp_dir",
"-txn",
"-txn_max",
"-use_environ",
"-use_environ_root",
NULL
};
enum envopen {
#ifdef CONFIG_TEST
ENV_ALLOC,
ENV_AUTO_COMMIT,
ENV_CDB,
ENV_CDB_ALLDB,
ENV_CLIENT_TO,
ENV_EVENT,
ENV_LOCK,
ENV_CONFLICT,
ENV_DETECT,
ENV_LOCK_MAX_LOCKS,
ENV_LOCK_MAX_LOCKERS,
ENV_LOCK_MAX_OBJECTS,
ENV_LOCK_TIMEOUT,
ENV_LOG,
ENV_LOG_FILEMODE,
ENV_LOG_BUFFER,
ENV_LOG_INMEMORY,
ENV_LOG_MAX,
ENV_LOG_REGIONMAX,
ENV_LOG_REMOVE,
ENV_MPOOL_MAX_OPENFD,
ENV_MPOOL_MAX_WRITE,
ENV_MPOOL_MMAP_SIZE,
ENV_MPOOL_NOMMAP,
ENV_MULTIVERSION,
ENV_OVERWRITE,
ENV_REGION_INIT,
ENV_REP,
ENV_REP_CLIENT,
ENV_REP_LEASE,
ENV_REP_MASTER,
ENV_REP_TRANSPORT,
ENV_SERVER,
ENV_SERVER_TO,
ENV_SET_INTERMEDIATE_DIR,
ENV_SNAPSHOT,
ENV_THREAD,
ENV_TIME_NOTGRANTED,
ENV_TXN_NOWAIT,
ENV_TXN_TIMEOUT,
ENV_TXN_TIME,
ENV_VERBOSE,
ENV_WRNOSYNC,
#endif
ENV_CACHESIZE,
ENV_CACHE_MAX,
ENV_CREATE,
ENV_DATA_DIR,
ENV_ENCRYPT_AES,
ENV_ENCRYPT_ANY,
ENV_ERRFILE,
ENV_ERRPFX,
ENV_HOME,
ENV_LOG_DIR,
ENV_MODE,
ENV_PRIVATE,
ENV_RECOVER,
ENV_RECOVER_FATAL,
ENV_REGISTER,
ENV_SHM_KEY,
ENV_SYSTEM_MEM,
ENV_TMP_DIR,
ENV_TXN,
ENV_TXN_MAX,
ENV_USE_ENVIRON,
ENV_USE_ENVIRON_ROOT
};
Tcl_Obj **myobjv;
u_int32_t cr_flags, gbytes, bytes, logbufset, logmaxset;
u_int32_t open_flags, rep_flags, set_flags, uintarg;
int i, mode, myobjc, ncaches, optindex, result, ret;
long client_to, server_to, shm;
char *arg, *home, *passwd, *server;
#ifdef CONFIG_TEST
Tcl_Obj **myobjv1;
time_t timestamp;
long v;
u_int32_t detect;
u_int8_t *conflicts;
int intarg, intarg2, j, nmodes, temp;
#endif
result = TCL_OK;
mode = 0;
rep_flags = set_flags = cr_flags = 0;
home = NULL;
open_flags = 0;
logmaxset = logbufset = 0;
if (objc <= 2) {
Tcl_WrongNumArgs(interp, 2, objv, "?args?");
return (TCL_ERROR);
}
server = NULL;
server_to = client_to = 0;
i = 2;
while (i < objc) {
if (Tcl_GetIndexFromObj(interp, objv[i++], envopen, "option",
TCL_EXACT, &optindex) != TCL_OK) {
Tcl_ResetResult(interp);
continue;
}
#ifdef CONFIG_TEST
switch ((enum envopen)optindex) {
case ENV_SERVER:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-server hostname");
result = TCL_ERROR;
break;
}
FLD_SET(cr_flags, DB_RPCCLIENT);
server = Tcl_GetStringFromObj(objv[i++], NULL);
break;
case ENV_SERVER_TO:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-server_to secs");
result = TCL_ERROR;
break;
}
FLD_SET(cr_flags, DB_RPCCLIENT);
result = Tcl_GetLongFromObj(interp, objv[i++],
&server_to);
break;
case ENV_CLIENT_TO:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-client_to secs");
result = TCL_ERROR;
break;
}
FLD_SET(cr_flags, DB_RPCCLIENT);
result = Tcl_GetLongFromObj(interp, objv[i++],
&client_to);
break;
default:
break;
}
#endif
}
if (result != TCL_OK)
return (TCL_ERROR);
ret = db_env_create(env, cr_flags);
if (ret)
return (_ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"db_env_create"));
(*env)->set_errpfx((*env), ip->i_name);
(*env)->set_errcall((*env), _ErrorFunc);
if (server != NULL &&
(ret = (*env)->set_rpc_server((*env), NULL, server,
client_to, server_to, 0)) != 0) {
result = TCL_ERROR;
goto error;
}
(*env)->app_private = ip;
i = 2;
while (i < objc) {
Tcl_ResetResult(interp);
if (Tcl_GetIndexFromObj(interp, objv[i], envopen, "option",
TCL_EXACT, &optindex) != TCL_OK) {
result = IS_HELP(objv[i]);
goto error;
}
i++;
switch ((enum envopen)optindex) {
#ifdef CONFIG_TEST
case ENV_SERVER:
case ENV_SERVER_TO:
case ENV_CLIENT_TO:
i++;
break;
case ENV_ALLOC:
(void)(*env)->set_alloc(*env,
tcl_db_malloc, tcl_db_realloc, tcl_db_free);
break;
case ENV_AUTO_COMMIT:
FLD_SET(set_flags, DB_AUTO_COMMIT);
break;
case ENV_CDB:
FLD_SET(open_flags, DB_INIT_CDB | DB_INIT_MPOOL);
break;
case ENV_CDB_ALLDB:
FLD_SET(set_flags, DB_CDB_ALLDB);
break;
case ENV_LOCK:
FLD_SET(open_flags, DB_INIT_LOCK | DB_INIT_MPOOL);
break;
case ENV_CONFLICT:
result = Tcl_ListObjGetElements(interp, objv[i],
&myobjc, &myobjv);
if (result == TCL_OK)
i++;
else
break;
if (myobjc != 2) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-lock_conflict {nmodes {matrix}}?");
result = TCL_ERROR;
break;
}
result = Tcl_GetIntFromObj(interp, myobjv[0], &nmodes);
if (result != TCL_OK)
break;
result = Tcl_ListObjGetElements(interp, myobjv[1],
&myobjc, &myobjv1);
if (myobjc != (nmodes * nmodes)) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-lock_conflict {nmodes {matrix}}?");
result = TCL_ERROR;
break;
}
ret = __os_malloc(*env, sizeof(u_int8_t) *
(size_t)nmodes * (size_t)nmodes, &conflicts);
if (ret != 0) {
result = TCL_ERROR;
break;
}
for (j = 0; j < myobjc; j++) {
result = Tcl_GetIntFromObj(interp, myobjv1[j],
&temp);
conflicts[j] = temp;
if (result != TCL_OK) {
__os_free(NULL, conflicts);
break;
}
}
_debug_check();
ret = (*env)->set_lk_conflicts(*env,
(u_int8_t *)conflicts, nmodes);
__os_free(NULL, conflicts);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"set_lk_conflicts");
break;
case ENV_DETECT:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-lock_detect policy?");
result = TCL_ERROR;
break;
}
arg = Tcl_GetStringFromObj(objv[i++], NULL);
if (strcmp(arg, "default") == 0)
detect = DB_LOCK_DEFAULT;
else if (strcmp(arg, "expire") == 0)
detect = DB_LOCK_EXPIRE;
else if (strcmp(arg, "maxlocks") == 0)
detect = DB_LOCK_MAXLOCKS;
else if (strcmp(arg, "maxwrites") == 0)
detect = DB_LOCK_MAXWRITE;
else if (strcmp(arg, "minlocks") == 0)
detect = DB_LOCK_MINLOCKS;
else if (strcmp(arg, "minwrites") == 0)
detect = DB_LOCK_MINWRITE;
else if (strcmp(arg, "oldest") == 0)
detect = DB_LOCK_OLDEST;
else if (strcmp(arg, "youngest") == 0)
detect = DB_LOCK_YOUNGEST;
else if (strcmp(arg, "random") == 0)
detect = DB_LOCK_RANDOM;
else {
Tcl_AddErrorInfo(interp,
"lock_detect: illegal policy");
result = TCL_ERROR;
break;
}
_debug_check();
ret = (*env)->set_lk_detect(*env, detect);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"lock_detect");
break;
case ENV_EVENT:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"-event eventproc");
result = TCL_ERROR;
break;
}
result = tcl_EventNotify(interp, *env, objv[i++], ip);
break;
case ENV_LOCK_MAX_LOCKS:
case ENV_LOCK_MAX_LOCKERS:
case ENV_LOCK_MAX_OBJECTS:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-lock_max max?");
result = TCL_ERROR;
break;
}
result = _GetUInt32(interp, objv[i++], &uintarg);
if (result == TCL_OK) {
_debug_check();
switch ((enum envopen)optindex) {
case ENV_LOCK_MAX_LOCKS:
ret = (*env)->set_lk_max_locks(*env,
uintarg);
break;
case ENV_LOCK_MAX_LOCKERS:
ret = (*env)->set_lk_max_lockers(*env,
uintarg);
break;
case ENV_LOCK_MAX_OBJECTS:
ret = (*env)->set_lk_max_objects(*env,
uintarg);
break;
default:
break;
}
result = _ReturnSetup(interp, ret,
DB_RETOK_STD(ret), "lock_max");
}
break;
case ENV_TXN_NOWAIT:
FLD_SET(set_flags, DB_TXN_NOWAIT);
break;
case ENV_TXN_TIME:
case ENV_TXN_TIMEOUT:
case ENV_LOCK_TIMEOUT:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-txn_timestamp time?");
result = TCL_ERROR;
break;
}
if ((result = Tcl_GetLongFromObj(
interp, objv[i++], &v)) != TCL_OK)
break;
timestamp = (time_t)v;
_debug_check();
if ((enum envopen)optindex == ENV_TXN_TIME)
ret =
(*env)->set_tx_timestamp(*env, ×tamp);
else
ret = (*env)->set_timeout(*env,
(db_timeout_t)timestamp,
(enum envopen)optindex == ENV_TXN_TIMEOUT ?
DB_SET_TXN_TIMEOUT : DB_SET_LOCK_TIMEOUT);
result = _ReturnSetup(interp, ret,
DB_RETOK_STD(ret), "txn_timestamp");
break;
case ENV_LOG:
FLD_SET(open_flags, DB_INIT_LOG | DB_INIT_MPOOL);
break;
case ENV_LOG_BUFFER:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-log_buffer size?");
result = TCL_ERROR;
break;
}
result = _GetUInt32(interp, objv[i++], &uintarg);
if (result == TCL_OK) {
_debug_check();
ret = (*env)->set_lg_bsize(*env, uintarg);
result = _ReturnSetup(interp, ret,
DB_RETOK_STD(ret), "log_bsize");
logbufset = 1;
if (logmaxset) {
_debug_check();
ret = (*env)->set_lg_max(*env,
logmaxset);
result = _ReturnSetup(interp, ret,
DB_RETOK_STD(ret), "log_max");
logmaxset = 0;
logbufset = 0;
}
}
break;
case ENV_LOG_FILEMODE:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-log_filemode mode?");
result = TCL_ERROR;
break;
}
result = _GetUInt32(interp, objv[i++], &uintarg);
if (result == TCL_OK) {
_debug_check();
ret =
(*env)->set_lg_filemode(*env, (int)uintarg);
result = _ReturnSetup(interp, ret,
DB_RETOK_STD(ret), "log_filemode");
}
break;
case ENV_LOG_INMEMORY:
FLD_SET(set_flags, DB_LOG_INMEMORY);
break;
case ENV_LOG_MAX:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-log_max max?");
result = TCL_ERROR;
break;
}
result = _GetUInt32(interp, objv[i++], &uintarg);
if (result == TCL_OK && logbufset) {
_debug_check();
ret = (*env)->set_lg_max(*env, uintarg);
result = _ReturnSetup(interp, ret,
DB_RETOK_STD(ret), "log_max");
logbufset = 0;
} else
logmaxset = uintarg;
break;
case ENV_LOG_REGIONMAX:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-log_regionmax size?");
result = TCL_ERROR;
break;
}
result = _GetUInt32(interp, objv[i++], &uintarg);
if (result == TCL_OK) {
_debug_check();
ret = (*env)->set_lg_regionmax(*env, uintarg);
result =
_ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"log_regionmax");
}
break;
case ENV_LOG_REMOVE:
FLD_SET(set_flags, DB_LOG_AUTOREMOVE);
break;
case ENV_MPOOL_MAX_OPENFD:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-mpool_max_openfd fd_count?");
result = TCL_ERROR;
break;
}
result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
if (result == TCL_OK) {
_debug_check();
ret = (*env)->set_mp_max_openfd(*env, intarg);
result = _ReturnSetup(interp, ret,
DB_RETOK_STD(ret), "mpool_max_openfd");
}
break;
case ENV_MPOOL_MAX_WRITE:
result = Tcl_ListObjGetElements(interp, objv[i],
&myobjc, &myobjv);
if (result == TCL_OK)
i++;
else
break;
if (myobjc != 2) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-mpool_max_write {nwrite nsleep}?");
result = TCL_ERROR;
break;
}
result = Tcl_GetIntFromObj(interp, myobjv[0], &intarg);
if (result != TCL_OK)
break;
result = Tcl_GetIntFromObj(interp, myobjv[1], &intarg2);
if (result != TCL_OK)
break;
_debug_check();
ret = (*env)->set_mp_max_write(
*env, intarg, (db_timeout_t)intarg2);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"set_mp_max_write");
break;
case ENV_MPOOL_MMAP_SIZE:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-mpool_mmap_size size?");
result = TCL_ERROR;
break;
}
result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
if (result == TCL_OK) {
_debug_check();
ret = (*env)->set_mp_mmapsize(*env,
(size_t)intarg);
result = _ReturnSetup(interp, ret,
DB_RETOK_STD(ret), "mpool_mmap_size");
}
break;
case ENV_MPOOL_NOMMAP:
FLD_SET(set_flags, DB_NOMMAP);
break;
case ENV_MULTIVERSION:
FLD_SET(set_flags, DB_MULTIVERSION);
break;
case ENV_OVERWRITE:
FLD_SET(set_flags, DB_OVERWRITE);
break;
case ENV_REGION_INIT:
_debug_check();
ret = (*env)->set_flags(*env, DB_REGION_INIT, 1);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"region_init");
break;
case ENV_SET_INTERMEDIATE_DIR:
if (i >= objc) {
Tcl_WrongNumArgs(interp,
2, objv, "?-set_intermediate_dir mode?");
result = TCL_ERROR;
break;
}
result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
if (result == TCL_OK) {
_debug_check();
ret = (*env)->
set_intermediate_dir(*env, intarg, 0);
result = _ReturnSetup(interp, ret,
DB_RETOK_STD(ret), "set_intermediate_dir");
}
break;
case ENV_REP:
FLD_SET(open_flags, DB_INIT_REP);
break;
case ENV_REP_CLIENT:
rep_flags = DB_REP_CLIENT;
FLD_SET(open_flags, DB_INIT_REP);
break;
case ENV_REP_MASTER:
rep_flags = DB_REP_MASTER;
FLD_SET(open_flags, DB_INIT_REP);
break;
case ENV_REP_LEASE:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"-rep_lease {nsites timeout clockskew}");
result = TCL_ERROR;
break;
}
result = Tcl_ListObjGetElements(interp, objv[i],
&myobjc, &myobjv);
if (result == TCL_OK)
i++;
else
break;
result = tcl_RepLease(interp, myobjc, myobjv, *env);
if (result == TCL_OK)
FLD_SET(open_flags, DB_INIT_REP);
break;
case ENV_REP_TRANSPORT:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"-rep_transport {envid sendproc}");
result = TCL_ERROR;
break;
}
result = Tcl_ListObjGetElements(interp, objv[i],
&myobjc, &myobjv);
if (result == TCL_OK)
i++;
else
break;
result = tcl_RepTransport(interp, myobjc, myobjv,
*env, ip);
if (result == TCL_OK)
FLD_SET(open_flags, DB_INIT_REP);
break;
case ENV_SNAPSHOT:
FLD_SET(set_flags, DB_TXN_SNAPSHOT);
break;
case ENV_THREAD:
FLD_SET(open_flags, DB_THREAD);
break;
case ENV_TIME_NOTGRANTED:
FLD_SET(set_flags, DB_TIME_NOTGRANTED);
break;
case ENV_VERBOSE:
result = Tcl_ListObjGetElements(interp, objv[i],
&myobjc, &myobjv);
if (result == TCL_OK)
i++;
else
break;
if (myobjc != 2) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-verbose {which on|off}?");
result = TCL_ERROR;
break;
}
result = tcl_EnvVerbose(interp, *env,
myobjv[0], myobjv[1]);
break;
case ENV_WRNOSYNC:
FLD_SET(set_flags, DB_TXN_WRITE_NOSYNC);
break;
#endif
case ENV_TXN:
FLD_SET(open_flags, DB_INIT_LOCK |
DB_INIT_LOG | DB_INIT_MPOOL | DB_INIT_TXN);
while (i < objc) {
arg = Tcl_GetStringFromObj(objv[i], NULL);
if (strcmp(arg, "nosync") == 0) {
FLD_SET(set_flags, DB_TXN_NOSYNC);
i++;
} else if (strcmp(arg, "snapshot") == 0) {
FLD_SET(set_flags, DB_TXN_SNAPSHOT);
i++;
} else
break;
}
break;
case ENV_CREATE:
FLD_SET(open_flags, DB_CREATE | DB_INIT_MPOOL);
break;
case ENV_ENCRYPT_AES:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-encryptaes passwd?");
result = TCL_ERROR;
break;
}
passwd = Tcl_GetStringFromObj(objv[i++], NULL);
_debug_check();
ret = (*env)->set_encrypt(*env, passwd, DB_ENCRYPT_AES);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"set_encrypt");
break;
case ENV_ENCRYPT_ANY:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-encryptany passwd?");
result = TCL_ERROR;
break;
}
passwd = Tcl_GetStringFromObj(objv[i++], NULL);
_debug_check();
ret = (*env)->set_encrypt(*env, passwd, 0);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"set_encrypt");
break;
case ENV_HOME:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-home dir?");
result = TCL_ERROR;
break;
}
home = Tcl_GetStringFromObj(objv[i++], NULL);
break;
case ENV_MODE:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-mode mode?");
result = TCL_ERROR;
break;
}
result = Tcl_GetIntFromObj(interp, objv[i++], &mode);
break;
case ENV_PRIVATE:
FLD_SET(open_flags, DB_PRIVATE | DB_INIT_MPOOL);
break;
case ENV_RECOVER:
FLD_SET(open_flags, DB_RECOVER);
break;
case ENV_RECOVER_FATAL:
FLD_SET(open_flags, DB_RECOVER_FATAL);
break;
case ENV_REGISTER:
FLD_SET(open_flags, DB_REGISTER);
break;
case ENV_SYSTEM_MEM:
FLD_SET(open_flags, DB_SYSTEM_MEM);
break;
case ENV_USE_ENVIRON_ROOT:
FLD_SET(open_flags, DB_USE_ENVIRON_ROOT);
break;
case ENV_USE_ENVIRON:
FLD_SET(open_flags, DB_USE_ENVIRON);
break;
case ENV_CACHESIZE:
result = Tcl_ListObjGetElements(interp, objv[i],
&myobjc, &myobjv);
if (result == TCL_OK)
i++;
else
break;
if (myobjc != 3) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-cachesize {gbytes bytes ncaches}?");
result = TCL_ERROR;
break;
}
result = _GetUInt32(interp, myobjv[0], &gbytes);
if (result != TCL_OK)
break;
result = _GetUInt32(interp, myobjv[1], &bytes);
if (result != TCL_OK)
break;
result = Tcl_GetIntFromObj(interp, myobjv[2], &ncaches);
if (result != TCL_OK)
break;
_debug_check();
ret = (*env)->set_cachesize(*env, gbytes, bytes,
ncaches);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"set_cachesize");
break;
case ENV_CACHE_MAX:
result = Tcl_ListObjGetElements(interp, objv[i],
&myobjc, &myobjv);
if (result == TCL_OK)
i++;
else
break;
if (myobjc != 2) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-cache_max {gbytes bytes}?");
result = TCL_ERROR;
break;
}
result = _GetUInt32(interp, myobjv[0], &gbytes);
if (result != TCL_OK)
break;
result = _GetUInt32(interp, myobjv[1], &bytes);
if (result != TCL_OK)
break;
_debug_check();
ret = (*env)->set_cache_max(*env, gbytes, bytes);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"set_cache_max");
break;
case ENV_SHM_KEY:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-shm_key key?");
result = TCL_ERROR;
break;
}
result = Tcl_GetLongFromObj(interp, objv[i++], &shm);
if (result == TCL_OK) {
_debug_check();
ret = (*env)->set_shm_key(*env, shm);
result = _ReturnSetup(interp, ret,
DB_RETOK_STD(ret), "shm_key");
}
break;
case ENV_TXN_MAX:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-txn_max max?");
result = TCL_ERROR;
break;
}
result = _GetUInt32(interp, objv[i++], &uintarg);
if (result == TCL_OK) {
_debug_check();
ret = (*env)->set_tx_max(*env, uintarg);
result = _ReturnSetup(interp, ret,
DB_RETOK_STD(ret), "txn_max");
}
break;
case ENV_ERRFILE:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"-errfile file");
result = TCL_ERROR;
break;
}
arg = Tcl_GetStringFromObj(objv[i++], NULL);
tcl_EnvSetErrfile(interp, *env, ip, arg);
break;
case ENV_ERRPFX:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"-errpfx prefix");
result = TCL_ERROR;
break;
}
arg = Tcl_GetStringFromObj(objv[i++], NULL);
_debug_check();
result = tcl_EnvSetErrpfx(interp, *env, ip, arg);
break;
case ENV_DATA_DIR:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"-data_dir dir");
result = TCL_ERROR;
break;
}
arg = Tcl_GetStringFromObj(objv[i++], NULL);
_debug_check();
ret = (*env)->set_data_dir(*env, arg);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"set_data_dir");
break;
case ENV_LOG_DIR:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"-log_dir dir");
result = TCL_ERROR;
break;
}
arg = Tcl_GetStringFromObj(objv[i++], NULL);
_debug_check();
ret = (*env)->set_lg_dir(*env, arg);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"set_lg_dir");
break;
case ENV_TMP_DIR:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"-tmp_dir dir");
result = TCL_ERROR;
break;
}
arg = Tcl_GetStringFromObj(objv[i++], NULL);
_debug_check();
ret = (*env)->set_tmp_dir(*env, arg);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"set_tmp_dir");
break;
}
if (result != TCL_OK)
goto error;
}
if (logmaxset) {
_debug_check();
ret = (*env)->set_lg_max(*env, (u_int32_t)logmaxset);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"log_max");
}
if (result != TCL_OK)
goto error;
if (set_flags) {
ret = (*env)->set_flags(*env, set_flags, 1);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"set_flags");
if (result == TCL_ERROR)
goto error;
Tcl_ResetResult(interp);
}
_debug_check();
ret = (*env)->open(*env, home, open_flags, mode);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "env open");
if (rep_flags != 0 && result == TCL_OK) {
_debug_check();
ret = (*env)->rep_start(*env, NULL, rep_flags);
result = _ReturnSetup(interp,
ret, DB_RETOK_STD(ret), "rep_start");
}
error: if (result == TCL_ERROR) {
if (ip->i_err && ip->i_err != stdout && ip->i_err != stderr) {
(void)fclose(ip->i_err);
ip->i_err = NULL;
}
(void)(*env)->close(*env, 0);
*env = NULL;
}
return (result);
}
static int
bdb_DbOpen(interp, objc, objv, ip, dbp)
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
DBTCL_INFO *ip;
DB **dbp;
{
static const char *bdbenvopen[] = {
"-env", NULL
};
enum bdbenvopen {
TCL_DB_ENV0
};
static const char *bdbopen[] = {
#ifdef CONFIG_TEST
"-btcompare",
"-dupcompare",
"-hashcompare",
"-hashproc",
"-lorder",
"-minkey",
"-nommap",
"-notdurable",
"-read_uncommitted",
"-revsplitoff",
"-test",
"-thread",
#endif
"-auto_commit",
"-btree",
"-cachesize",
"-chksum",
"-create",
"-delim",
"-dup",
"-dupsort",
"-encrypt",
"-encryptaes",
"-encryptany",
"-env",
"-errfile",
"-errpfx",
"-excl",
"-extent",
"-ffactor",
"-hash",
"-inorder",
"-len",
"-maxsize",
"-mode",
"-multiversion",
"-nelem",
"-pad",
"-pagesize",
"-queue",
"-rdonly",
"-recno",
"-recnum",
"-renumber",
"-snapshot",
"-source",
"-truncate",
"-txn",
"-unknown",
"--",
NULL
};
enum bdbopen {
#ifdef CONFIG_TEST
TCL_DB_BTCOMPARE,
TCL_DB_DUPCOMPARE,
TCL_DB_HASHCOMPARE,
TCL_DB_HASHPROC,
TCL_DB_LORDER,
TCL_DB_MINKEY,
TCL_DB_NOMMAP,
TCL_DB_NOTDURABLE,
TCL_DB_READ_UNCOMMITTED,
TCL_DB_REVSPLIT,
TCL_DB_TEST,
TCL_DB_THREAD,
#endif
TCL_DB_AUTO_COMMIT,
TCL_DB_BTREE,
TCL_DB_CACHESIZE,
TCL_DB_CHKSUM,
TCL_DB_CREATE,
TCL_DB_DELIM,
TCL_DB_DUP,
TCL_DB_DUPSORT,
TCL_DB_ENCRYPT,
TCL_DB_ENCRYPT_AES,
TCL_DB_ENCRYPT_ANY,
TCL_DB_ENV,
TCL_DB_ERRFILE,
TCL_DB_ERRPFX,
TCL_DB_EXCL,
TCL_DB_EXTENT,
TCL_DB_FFACTOR,
TCL_DB_HASH,
TCL_DB_INORDER,
TCL_DB_LEN,
TCL_DB_MAXSIZE,
TCL_DB_MODE,
TCL_DB_MULTIVERSION,
TCL_DB_NELEM,
TCL_DB_PAD,
TCL_DB_PAGESIZE,
TCL_DB_QUEUE,
TCL_DB_RDONLY,
TCL_DB_RECNO,
TCL_DB_RECNUM,
TCL_DB_RENUMBER,
TCL_DB_SNAPSHOT,
TCL_DB_SOURCE,
TCL_DB_TRUNCATE,
TCL_DB_TXN,
TCL_DB_UNKNOWN,
TCL_DB_ENDARG
};
DBTCL_INFO *envip, *errip;
DB_TXN *txn;
DBTYPE type;
DB_ENV *envp;
Tcl_Obj **myobjv;
u_int32_t gbytes, bytes, open_flags, set_flags, uintarg;
int endarg, i, intarg, mode, myobjc, ncaches;
int optindex, result, ret, set_err, set_pfx, subdblen;
u_char *subdbtmp;
char *arg, *db, *passwd, *subdb, msg[MSG_SIZE];
type = DB_UNKNOWN;
endarg = mode = set_err = set_flags = set_pfx = 0;
result = TCL_OK;
subdbtmp = NULL;
db = subdb = NULL;
open_flags = 0;
envp = NULL;
txn = NULL;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 2, objv, "?args?");
return (TCL_ERROR);
}
i = 2;
while (i < objc) {
if (Tcl_GetIndexFromObj(interp, objv[i++], bdbenvopen,
"option", TCL_EXACT, &optindex) != TCL_OK) {
Tcl_ResetResult(interp);
continue;
}
switch ((enum bdbenvopen)optindex) {
case TCL_DB_ENV0:
arg = Tcl_GetStringFromObj(objv[i], NULL);
envp = NAME_TO_ENV(arg);
if (envp == NULL) {
Tcl_SetResult(interp,
"db open: illegal environment", TCL_STATIC);
return (TCL_ERROR);
}
}
break;
}
ret = db_create(dbp, envp, 0);
if (ret)
return (_ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"db_create"));
(*dbp)->api_internal = ip;
if (envp == NULL) {
(*dbp)->set_errpfx((*dbp), ip->i_name);
(*dbp)->set_errcall((*dbp), _ErrorFunc);
}
envip = _PtrToInfo(envp);
if (envip)
errip = envip;
else
errip = ip;
i = 2;
while (i < objc) {
Tcl_ResetResult(interp);
if (Tcl_GetIndexFromObj(interp, objv[i], bdbopen, "option",
TCL_EXACT, &optindex) != TCL_OK) {
arg = Tcl_GetStringFromObj(objv[i], NULL);
if (arg[0] == '-') {
result = IS_HELP(objv[i]);
goto error;
} else
Tcl_ResetResult(interp);
break;
}
i++;
switch ((enum bdbopen)optindex) {
#ifdef CONFIG_TEST
case TCL_DB_BTCOMPARE:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"-btcompare compareproc");
result = TCL_ERROR;
break;
}
ip->i_compare = objv[i++];
Tcl_IncrRefCount(ip->i_compare);
_debug_check();
ret = (*dbp)->set_bt_compare(*dbp, tcl_bt_compare);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"set_bt_compare");
break;
case TCL_DB_DUPCOMPARE:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"-dupcompare compareproc");
result = TCL_ERROR;
break;
}
ip->i_dupcompare = objv[i++];
Tcl_IncrRefCount(ip->i_dupcompare);
_debug_check();
ret = (*dbp)->set_dup_compare(*dbp, tcl_dup_compare);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"set_dup_compare");
break;
case TCL_DB_HASHCOMPARE:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"-hashcompare compareproc");
result = TCL_ERROR;
break;
}
ip->i_compare = objv[i++];
Tcl_IncrRefCount(ip->i_compare);
_debug_check();
ret = (*dbp)->set_h_compare(*dbp, tcl_bt_compare);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"set_h_compare");
break;
case TCL_DB_HASHPROC:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"-hashproc hashproc");
result = TCL_ERROR;
break;
}
ip->i_hashproc = objv[i++];
Tcl_IncrRefCount(ip->i_hashproc);
_debug_check();
ret = (*dbp)->set_h_hash(*dbp, tcl_h_hash);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"set_h_hash");
break;
case TCL_DB_LORDER:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"-lorder 1234|4321");
result = TCL_ERROR;
break;
}
result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
if (result == TCL_OK) {
_debug_check();
ret = (*dbp)->set_lorder(*dbp, intarg);
result = _ReturnSetup(interp, ret,
DB_RETOK_STD(ret), "set_lorder");
}
break;
case TCL_DB_MINKEY:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"-minkey minkey");
result = TCL_ERROR;
break;
}
result = _GetUInt32(interp, objv[i++], &uintarg);
if (result == TCL_OK) {
_debug_check();
ret = (*dbp)->set_bt_minkey(*dbp, uintarg);
result = _ReturnSetup(interp, ret,
DB_RETOK_STD(ret), "set_bt_minkey");
}
break;
case TCL_DB_NOMMAP:
open_flags |= DB_NOMMAP;
break;
case TCL_DB_NOTDURABLE:
set_flags |= DB_TXN_NOT_DURABLE;
break;
case TCL_DB_READ_UNCOMMITTED:
open_flags |= DB_READ_UNCOMMITTED;
break;
case TCL_DB_REVSPLIT:
set_flags |= DB_REVSPLITOFF;
break;
case TCL_DB_TEST:
ret = (*dbp)->set_h_hash(*dbp, __ham_test);
result = _ReturnSetup(interp, ret,
DB_RETOK_STD(ret), "set_h_hash");
break;
case TCL_DB_THREAD:
open_flags |= DB_THREAD;
break;
#endif
case TCL_DB_AUTO_COMMIT:
open_flags |= DB_AUTO_COMMIT;
break;
case TCL_DB_ENV:
i++;
continue;
case TCL_DB_TXN:
if (i > (objc - 1)) {
Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?");
result = TCL_ERROR;
break;
}
arg = Tcl_GetStringFromObj(objv[i++], NULL);
txn = NAME_TO_TXN(arg);
if (txn == NULL) {
snprintf(msg, MSG_SIZE,
"Open: Invalid txn: %s\n", arg);
Tcl_SetResult(interp, msg, TCL_VOLATILE);
result = TCL_ERROR;
}
break;
case TCL_DB_BTREE:
if (type != DB_UNKNOWN) {
Tcl_SetResult(interp,
"Too many DB types specified", TCL_STATIC);
result = TCL_ERROR;
goto error;
}
type = DB_BTREE;
break;
case TCL_DB_HASH:
if (type != DB_UNKNOWN) {
Tcl_SetResult(interp,
"Too many DB types specified", TCL_STATIC);
result = TCL_ERROR;
goto error;
}
type = DB_HASH;
break;
case TCL_DB_RECNO:
if (type != DB_UNKNOWN) {
Tcl_SetResult(interp,
"Too many DB types specified", TCL_STATIC);
result = TCL_ERROR;
goto error;
}
type = DB_RECNO;
break;
case TCL_DB_QUEUE:
if (type != DB_UNKNOWN) {
Tcl_SetResult(interp,
"Too many DB types specified", TCL_STATIC);
result = TCL_ERROR;
goto error;
}
type = DB_QUEUE;
break;
case TCL_DB_UNKNOWN:
if (type != DB_UNKNOWN) {
Tcl_SetResult(interp,
"Too many DB types specified", TCL_STATIC);
result = TCL_ERROR;
goto error;
}
break;
case TCL_DB_CREATE:
open_flags |= DB_CREATE;
break;
case TCL_DB_EXCL:
open_flags |= DB_EXCL;
break;
case TCL_DB_RDONLY:
open_flags |= DB_RDONLY;
break;
case TCL_DB_TRUNCATE:
open_flags |= DB_TRUNCATE;
break;
case TCL_DB_MODE:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-mode mode?");
result = TCL_ERROR;
break;
}
result = Tcl_GetIntFromObj(interp, objv[i++], &mode);
break;
case TCL_DB_DUP:
set_flags |= DB_DUP;
break;
case TCL_DB_DUPSORT:
set_flags |= DB_DUPSORT;
break;
case TCL_DB_INORDER:
set_flags |= DB_INORDER;
break;
case TCL_DB_RECNUM:
set_flags |= DB_RECNUM;
break;
case TCL_DB_RENUMBER:
set_flags |= DB_RENUMBER;
break;
case TCL_DB_SNAPSHOT:
set_flags |= DB_SNAPSHOT;
break;
case TCL_DB_CHKSUM:
set_flags |= DB_CHKSUM;
break;
case TCL_DB_ENCRYPT:
set_flags |= DB_ENCRYPT;
break;
case TCL_DB_ENCRYPT_AES:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-encryptaes passwd?");
result = TCL_ERROR;
break;
}
passwd = Tcl_GetStringFromObj(objv[i++], NULL);
_debug_check();
ret = (*dbp)->set_encrypt(*dbp, passwd, DB_ENCRYPT_AES);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"set_encrypt");
break;
case TCL_DB_ENCRYPT_ANY:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-encryptany passwd?");
result = TCL_ERROR;
break;
}
passwd = Tcl_GetStringFromObj(objv[i++], NULL);
_debug_check();
ret = (*dbp)->set_encrypt(*dbp, passwd, 0);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"set_encrypt");
break;
case TCL_DB_FFACTOR:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"-ffactor density");
result = TCL_ERROR;
break;
}
result = _GetUInt32(interp, objv[i++], &uintarg);
if (result == TCL_OK) {
_debug_check();
ret = (*dbp)->set_h_ffactor(*dbp, uintarg);
result = _ReturnSetup(interp, ret,
DB_RETOK_STD(ret), "set_h_ffactor");
}
break;
case TCL_DB_MULTIVERSION:
open_flags |= DB_MULTIVERSION;
break;
case TCL_DB_NELEM:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"-nelem nelem");
result = TCL_ERROR;
break;
}
result = _GetUInt32(interp, objv[i++], &uintarg);
if (result == TCL_OK) {
_debug_check();
ret = (*dbp)->set_h_nelem(*dbp, uintarg);
result = _ReturnSetup(interp, ret,
DB_RETOK_STD(ret), "set_h_nelem");
}
break;
case TCL_DB_DELIM:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"-delim delim");
result = TCL_ERROR;
break;
}
result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
if (result == TCL_OK) {
_debug_check();
ret = (*dbp)->set_re_delim(*dbp, intarg);
result = _ReturnSetup(interp, ret,
DB_RETOK_STD(ret), "set_re_delim");
}
break;
case TCL_DB_LEN:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"-len length");
result = TCL_ERROR;
break;
}
result = _GetUInt32(interp, objv[i++], &uintarg);
if (result == TCL_OK) {
_debug_check();
ret = (*dbp)->set_re_len(*dbp, uintarg);
result = _ReturnSetup(interp, ret,
DB_RETOK_STD(ret), "set_re_len");
}
break;
case TCL_DB_MAXSIZE:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"-len length");
result = TCL_ERROR;
break;
}
result = _GetUInt32(interp, objv[i++], &uintarg);
if (result == TCL_OK) {
_debug_check();
ret = (*dbp)->mpf->set_maxsize(
(*dbp)->mpf, 0, uintarg);
result = _ReturnSetup(interp, ret,
DB_RETOK_STD(ret), "set_re_len");
}
break;
case TCL_DB_PAD:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"-pad pad");
result = TCL_ERROR;
break;
}
result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
if (result == TCL_OK) {
_debug_check();
ret = (*dbp)->set_re_pad(*dbp, intarg);
result = _ReturnSetup(interp, ret,
DB_RETOK_STD(ret), "set_re_pad");
}
break;
case TCL_DB_SOURCE:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"-source file");
result = TCL_ERROR;
break;
}
arg = Tcl_GetStringFromObj(objv[i++], NULL);
_debug_check();
ret = (*dbp)->set_re_source(*dbp, arg);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"set_re_source");
break;
case TCL_DB_EXTENT:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"-extent size");
result = TCL_ERROR;
break;
}
result = _GetUInt32(interp, objv[i++], &uintarg);
if (result == TCL_OK) {
_debug_check();
ret = (*dbp)->set_q_extentsize(*dbp, uintarg);
result = _ReturnSetup(interp, ret,
DB_RETOK_STD(ret), "set_q_extentsize");
}
break;
case TCL_DB_CACHESIZE:
result = Tcl_ListObjGetElements(interp, objv[i++],
&myobjc, &myobjv);
if (result != TCL_OK)
break;
if (myobjc != 3) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-cachesize {gbytes bytes ncaches}?");
result = TCL_ERROR;
break;
}
result = _GetUInt32(interp, myobjv[0], &gbytes);
if (result != TCL_OK)
break;
result = _GetUInt32(interp, myobjv[1], &bytes);
if (result != TCL_OK)
break;
result = Tcl_GetIntFromObj(interp, myobjv[2], &ncaches);
if (result != TCL_OK)
break;
_debug_check();
ret = (*dbp)->set_cachesize(*dbp, gbytes, bytes,
ncaches);
result = _ReturnSetup(interp, ret,
DB_RETOK_STD(ret), "set_cachesize");
break;
case TCL_DB_PAGESIZE:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-pagesize size?");
result = TCL_ERROR;
break;
}
result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
if (result == TCL_OK) {
_debug_check();
ret = (*dbp)->set_pagesize(*dbp,
(size_t)intarg);
result = _ReturnSetup(interp, ret,
DB_RETOK_STD(ret), "set pagesize");
}
break;
case TCL_DB_ERRFILE:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"-errfile file");
result = TCL_ERROR;
break;
}
arg = Tcl_GetStringFromObj(objv[i++], NULL);
if (errip->i_err != NULL &&
errip->i_err != stdout && errip->i_err != stderr)
(void)fclose(errip->i_err);
if (strcmp(arg, "/dev/stdout") == 0)
errip->i_err = stdout;
else if (strcmp(arg, "/dev/stderr") == 0)
errip->i_err = stderr;
else
errip->i_err = fopen(arg, "a");
if (errip->i_err != NULL) {
_debug_check();
(*dbp)->set_errfile(*dbp, errip->i_err);
set_err = 1;
}
break;
case TCL_DB_ERRPFX:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"-errpfx prefix");
result = TCL_ERROR;
break;
}
arg = Tcl_GetStringFromObj(objv[i++], NULL);
if (errip->i_errpfx != NULL)
__os_free(NULL, errip->i_errpfx);
if ((ret = __os_strdup((*dbp)->dbenv,
arg, &errip->i_errpfx)) != 0) {
result = _ReturnSetup(interp, ret,
DB_RETOK_STD(ret), "__os_strdup");
break;
}
if (errip->i_errpfx != NULL) {
_debug_check();
(*dbp)->set_errpfx(*dbp, errip->i_errpfx);
set_pfx = 1;
}
break;
case TCL_DB_ENDARG:
endarg = 1;
break;
}
if (result != TCL_OK)
goto error;
if (endarg)
break;
}
if (result != TCL_OK)
goto error;
if (i != objc) {
db = Tcl_GetStringFromObj(objv[i++], NULL);
if (strcmp(db, "") == 0)
db = NULL;
if (i != objc) {
subdbtmp =
Tcl_GetByteArrayFromObj(objv[i++], &subdblen);
if ((ret = __os_malloc(envp,
(size_t)subdblen + 1, &subdb)) != 0) {
Tcl_SetResult(interp, db_strerror(ret),
TCL_STATIC);
return (0);
}
memcpy(subdb, subdbtmp, (size_t)subdblen);
subdb[subdblen] = '\0';
}
}
if (set_flags) {
ret = (*dbp)->set_flags(*dbp, set_flags);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"set_flags");
if (result == TCL_ERROR)
goto error;
Tcl_ResetResult(interp);
}
_debug_check();
ret = (*dbp)->open(*dbp, txn, db, subdb, type, open_flags, mode);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db open");
error:
if (subdb)
__os_free(envp, subdb);
if (result == TCL_ERROR) {
(void)(*dbp)->close(*dbp, 0);
if (set_err && errip && errip->i_err != NULL &&
errip->i_err != stdout && errip->i_err != stderr) {
(void)fclose(errip->i_err);
errip->i_err = NULL;
}
if (set_pfx && errip && errip->i_errpfx != NULL) {
__os_free(envp, errip->i_errpfx);
errip->i_errpfx = NULL;
}
*dbp = NULL;
}
return (result);
}
#ifdef HAVE_64BIT_TYPES
static int
bdb_SeqOpen(interp, objc, objv, ip, seqp)
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
DBTCL_INFO *ip;
DB_SEQUENCE **seqp;
{
static const char *seqopen[] = {
"-cachesize",
"-create",
"-inc",
"-init",
"-dec",
"-max",
"-min",
"-thread",
"-txn",
"-wrap",
"--",
NULL
} ;
enum seqopen {
TCL_SEQ_CACHESIZE,
TCL_SEQ_CREATE,
TCL_SEQ_INC,
TCL_SEQ_INIT,
TCL_SEQ_DEC,
TCL_SEQ_MAX,
TCL_SEQ_MIN,
TCL_SEQ_THREAD,
TCL_SEQ_TXN,
TCL_SEQ_WRAP,
TCL_SEQ_ENDARG
};
DB *dbp;
DBT key;
DBTYPE type;
DB_TXN *txn;
db_recno_t recno;
db_seq_t min, max, value;
Tcl_WideInt tcl_value;
u_int32_t flags, oflags;
int cache, endarg, i, optindex, result, ret, setrange, setvalue, v;
char *arg, *db, msg[MSG_SIZE];
COMPQUIET(ip, NULL);
COMPQUIET(value, 0);
*seqp = NULL;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 2, objv, "?args?");
return (TCL_ERROR);
}
txn = NULL;
endarg = 0;
flags = oflags = 0;
setrange = setvalue = 0;
min = INT64_MIN;
max = INT64_MAX;
cache = 0;
for (i = 2; i < objc;) {
Tcl_ResetResult(interp);
if (Tcl_GetIndexFromObj(interp, objv[i], seqopen, "option",
TCL_EXACT, &optindex) != TCL_OK) {
arg = Tcl_GetStringFromObj(objv[i], NULL);
if (arg[0] == '-') {
result = IS_HELP(objv[i]);
goto error;
} else
Tcl_ResetResult(interp);
break;
}
i++;
result = TCL_OK;
switch ((enum seqopen)optindex) {
case TCL_SEQ_CREATE:
oflags |= DB_CREATE;
break;
case TCL_SEQ_INC:
LF_SET(DB_SEQ_INC);
break;
case TCL_SEQ_CACHESIZE:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-cachesize value?");
result = TCL_ERROR;
break;
}
result = Tcl_GetIntFromObj(interp, objv[i++], &cache);
break;
case TCL_SEQ_INIT:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-init value?");
result = TCL_ERROR;
break;
}
result =
Tcl_GetWideIntFromObj(
interp, objv[i++], &tcl_value);
value = tcl_value;
setvalue = 1;
break;
case TCL_SEQ_DEC:
LF_SET(DB_SEQ_DEC);
break;
case TCL_SEQ_MAX:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-max value?");
result = TCL_ERROR;
break;
}
if ((result =
Tcl_GetWideIntFromObj(interp,
objv[i++], &tcl_value)) != TCL_OK)
goto error;
max = tcl_value;
setrange = 1;
break;
case TCL_SEQ_MIN:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-min value?");
result = TCL_ERROR;
break;
}
if ((result =
Tcl_GetWideIntFromObj(interp,
objv[i++], &tcl_value)) != TCL_OK)
goto error;
min = tcl_value;
setrange = 1;
break;
case TCL_SEQ_THREAD:
oflags |= DB_THREAD;
break;
case TCL_SEQ_TXN:
if (i > (objc - 1)) {
Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?");
result = TCL_ERROR;
break;
}
arg = Tcl_GetStringFromObj(objv[i++], NULL);
txn = NAME_TO_TXN(arg);
if (txn == NULL) {
snprintf(msg, MSG_SIZE,
"Sequence: Invalid txn: %s\n", arg);
Tcl_SetResult(interp, msg, TCL_VOLATILE);
result = TCL_ERROR;
}
break;
case TCL_SEQ_WRAP:
LF_SET(DB_SEQ_WRAP);
break;
case TCL_SEQ_ENDARG:
endarg = 1;
break;
}
if (result != TCL_OK)
goto error;
if (endarg)
break;
}
if (objc - i != 2) {
Tcl_WrongNumArgs(interp, 2, objv, "?args?");
return (TCL_ERROR);
}
db = Tcl_GetStringFromObj(objv[i++], NULL);
if ((dbp = NAME_TO_DB(db)) == NULL) {
Tcl_SetResult(interp, "No such dbp", TCL_STATIC);
return (TCL_ERROR);
}
(void)dbp->get_type(dbp, &type);
if (type == DB_QUEUE || type == DB_RECNO) {
result = _GetUInt32(interp, objv[i++], &recno);
if (result != TCL_OK)
return (result);
DB_INIT_DBT(key, &recno, sizeof(recno));
} else
DB_INIT_DBT(key, Tcl_GetByteArrayFromObj(objv[i++], &v), v);
ret = db_sequence_create(seqp, dbp, 0);
if ((result = _ReturnSetup(interp,
ret, DB_RETOK_STD(ret), "sequence create")) != TCL_OK) {
*seqp = NULL;
return (result);
}
ret = (*seqp)->set_flags(*seqp, flags);
if ((result = _ReturnSetup(interp,
ret, DB_RETOK_STD(ret), "sequence set_flags")) != TCL_OK)
goto error;
if (setrange) {
ret = (*seqp)->set_range(*seqp, min, max);
if ((result = _ReturnSetup(interp,
ret, DB_RETOK_STD(ret), "sequence set_range")) != TCL_OK)
goto error;
}
if (cache) {
ret = (*seqp)->set_cachesize(*seqp, cache);
if ((result = _ReturnSetup(interp,
ret, DB_RETOK_STD(ret), "sequence cachesize")) != TCL_OK)
goto error;
}
if (setvalue) {
ret = (*seqp)->initial_value(*seqp, value);
if ((result = _ReturnSetup(interp,
ret, DB_RETOK_STD(ret), "sequence init")) != TCL_OK)
goto error;
}
ret = (*seqp)->open(*seqp, txn, &key, oflags);
if ((result = _ReturnSetup(interp,
ret, DB_RETOK_STD(ret), "sequence open")) != TCL_OK)
goto error;
if (0) {
error: if (*seqp != NULL)
(void)(*seqp)->close(*seqp, 0);
*seqp = NULL;
}
return (result);
}
#endif
static int
bdb_DbRemove(interp, objc, objv)
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
static const char *bdbrem[] = {
"-auto_commit",
"-encrypt",
"-encryptaes",
"-encryptany",
"-env",
"-txn",
"--",
NULL
};
enum bdbrem {
TCL_DBREM_AUTOCOMMIT,
TCL_DBREM_ENCRYPT,
TCL_DBREM_ENCRYPT_AES,
TCL_DBREM_ENCRYPT_ANY,
TCL_DBREM_ENV,
TCL_DBREM_TXN,
TCL_DBREM_ENDARG
};
DB *dbp;
DB_ENV *envp;
DB_TXN *txn;
int endarg, i, optindex, result, ret, subdblen;
u_int32_t enc_flag, iflags, set_flags;
u_char *subdbtmp;
char *arg, *db, msg[MSG_SIZE], *passwd, *subdb;
db = subdb = NULL;
dbp = NULL;
endarg = 0;
envp = NULL;
iflags = enc_flag = set_flags = 0;
passwd = NULL;
result = TCL_OK;
subdbtmp = NULL;
txn = NULL;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 2, objv, "?args? filename ?database?");
return (TCL_ERROR);
}
i = 2;
while (i < objc) {
if (Tcl_GetIndexFromObj(interp, objv[i], bdbrem,
"option", TCL_EXACT, &optindex) != TCL_OK) {
arg = Tcl_GetStringFromObj(objv[i], NULL);
if (arg[0] == '-') {
result = IS_HELP(objv[i]);
goto error;
} else
Tcl_ResetResult(interp);
break;
}
i++;
switch ((enum bdbrem)optindex) {
case TCL_DBREM_AUTOCOMMIT:
iflags |= DB_AUTO_COMMIT;
_debug_check();
break;
case TCL_DBREM_ENCRYPT:
set_flags |= DB_ENCRYPT;
_debug_check();
break;
case TCL_DBREM_ENCRYPT_AES:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-encryptaes passwd?");
result = TCL_ERROR;
break;
}
passwd = Tcl_GetStringFromObj(objv[i++], NULL);
enc_flag = DB_ENCRYPT_AES;
break;
case TCL_DBREM_ENCRYPT_ANY:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-encryptany passwd?");
result = TCL_ERROR;
break;
}
passwd = Tcl_GetStringFromObj(objv[i++], NULL);
enc_flag = 0;
break;
case TCL_DBREM_ENV:
arg = Tcl_GetStringFromObj(objv[i++], NULL);
envp = NAME_TO_ENV(arg);
if (envp == NULL) {
Tcl_SetResult(interp,
"db remove: illegal environment",
TCL_STATIC);
return (TCL_ERROR);
}
break;
case TCL_DBREM_ENDARG:
endarg = 1;
break;
case TCL_DBREM_TXN:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?");
result = TCL_ERROR;
break;
}
arg = Tcl_GetStringFromObj(objv[i++], NULL);
txn = NAME_TO_TXN(arg);
if (txn == NULL) {
snprintf(msg, MSG_SIZE,
"Put: Invalid txn: %s\n", arg);
Tcl_SetResult(interp, msg, TCL_VOLATILE);
result = TCL_ERROR;
}
break;
}
if (result != TCL_OK)
goto error;
if (endarg)
break;
}
if (result != TCL_OK)
goto error;
if ((i != (objc - 1)) || (i != (objc - 2))) {
db = Tcl_GetStringFromObj(objv[i++], NULL);
if (strcmp(db, "") == 0)
db = NULL;
if (i != objc) {
subdbtmp =
Tcl_GetByteArrayFromObj(objv[i++], &subdblen);
if ((ret = __os_malloc(envp, (size_t)subdblen + 1,
&subdb)) != 0) { Tcl_SetResult(interp,
db_strerror(ret), TCL_STATIC);
return (0);
}
memcpy(subdb, subdbtmp, (size_t)subdblen);
subdb[subdblen] = '\0';
}
} else {
Tcl_WrongNumArgs(interp, 2, objv, "?args? filename ?database?");
result = TCL_ERROR;
goto error;
}
if (envp == NULL) {
ret = db_create(&dbp, envp, 0);
if (ret) {
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"db_create");
goto error;
}
dbp->set_errpfx(dbp, "DbRemove");
dbp->set_errcall(dbp, _ErrorFunc);
if (passwd != NULL) {
ret = dbp->set_encrypt(dbp, passwd, enc_flag);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"set_encrypt");
}
if (set_flags != 0) {
ret = dbp->set_flags(dbp, set_flags);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"set_flags");
}
}
_debug_check();
if (dbp == NULL)
ret = envp->dbremove(envp, txn, db, subdb, iflags);
else
ret = dbp->remove(dbp, db, subdb, 0);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db remove");
dbp = NULL;
error:
if (subdb)
__os_free(envp, subdb);
if (result == TCL_ERROR && dbp != NULL)
(void)dbp->close(dbp, 0);
return (result);
}
static int
bdb_DbRename(interp, objc, objv)
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
static const char *bdbmv[] = {
"-auto_commit",
"-encrypt",
"-encryptaes",
"-encryptany",
"-env",
"-txn",
"--",
NULL
};
enum bdbmv {
TCL_DBMV_AUTOCOMMIT,
TCL_DBMV_ENCRYPT,
TCL_DBMV_ENCRYPT_AES,
TCL_DBMV_ENCRYPT_ANY,
TCL_DBMV_ENV,
TCL_DBMV_TXN,
TCL_DBMV_ENDARG
};
DB *dbp;
DB_ENV *envp;
DB_TXN *txn;
u_int32_t enc_flag, iflags, set_flags;
int endarg, i, newlen, optindex, result, ret, subdblen;
u_char *subdbtmp;
char *arg, *db, msg[MSG_SIZE], *newname, *passwd, *subdb;
db = newname = subdb = NULL;
dbp = NULL;
endarg = 0;
envp = NULL;
iflags = enc_flag = set_flags = 0;
passwd = NULL;
result = TCL_OK;
subdbtmp = NULL;
txn = NULL;
if (objc < 2) {
Tcl_WrongNumArgs(interp,
3, objv, "?args? filename ?database? ?newname?");
return (TCL_ERROR);
}
i = 2;
while (i < objc) {
if (Tcl_GetIndexFromObj(interp, objv[i], bdbmv,
"option", TCL_EXACT, &optindex) != TCL_OK) {
arg = Tcl_GetStringFromObj(objv[i], NULL);
if (arg[0] == '-') {
result = IS_HELP(objv[i]);
goto error;
} else
Tcl_ResetResult(interp);
break;
}
i++;
switch ((enum bdbmv)optindex) {
case TCL_DBMV_AUTOCOMMIT:
iflags |= DB_AUTO_COMMIT;
_debug_check();
break;
case TCL_DBMV_ENCRYPT:
set_flags |= DB_ENCRYPT;
_debug_check();
break;
case TCL_DBMV_ENCRYPT_AES:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-encryptaes passwd?");
result = TCL_ERROR;
break;
}
passwd = Tcl_GetStringFromObj(objv[i++], NULL);
enc_flag = DB_ENCRYPT_AES;
break;
case TCL_DBMV_ENCRYPT_ANY:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-encryptany passwd?");
result = TCL_ERROR;
break;
}
passwd = Tcl_GetStringFromObj(objv[i++], NULL);
enc_flag = 0;
break;
case TCL_DBMV_ENV:
arg = Tcl_GetStringFromObj(objv[i++], NULL);
envp = NAME_TO_ENV(arg);
if (envp == NULL) {
Tcl_SetResult(interp,
"db rename: illegal environment",
TCL_STATIC);
return (TCL_ERROR);
}
break;
case TCL_DBMV_ENDARG:
endarg = 1;
break;
case TCL_DBMV_TXN:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?");
result = TCL_ERROR;
break;
}
arg = Tcl_GetStringFromObj(objv[i++], NULL);
txn = NAME_TO_TXN(arg);
if (txn == NULL) {
snprintf(msg, MSG_SIZE,
"Put: Invalid txn: %s\n", arg);
Tcl_SetResult(interp, msg, TCL_VOLATILE);
result = TCL_ERROR;
}
break;
}
if (result != TCL_OK)
goto error;
if (endarg)
break;
}
if (result != TCL_OK)
goto error;
if ((i != (objc - 2)) || (i != (objc - 3))) {
db = Tcl_GetStringFromObj(objv[i++], NULL);
if (strcmp(db, "") == 0)
db = NULL;
if (i == objc - 2) {
subdbtmp =
Tcl_GetByteArrayFromObj(objv[i++], &subdblen);
if ((ret = __os_malloc(envp, (size_t)subdblen + 1,
&subdb)) != 0) {
Tcl_SetResult(interp,
db_strerror(ret), TCL_STATIC);
return (0);
}
memcpy(subdb, subdbtmp, (size_t)subdblen);
subdb[subdblen] = '\0';
}
subdbtmp =
Tcl_GetByteArrayFromObj(objv[i++], &newlen);
if ((ret = __os_malloc(envp, (size_t)newlen + 1,
&newname)) != 0) {
Tcl_SetResult(interp,
db_strerror(ret), TCL_STATIC);
return (0);
}
memcpy(newname, subdbtmp, (size_t)newlen);
newname[newlen] = '\0';
} else {
Tcl_WrongNumArgs(
interp, 3, objv, "?args? filename ?database? ?newname?");
result = TCL_ERROR;
goto error;
}
if (envp == NULL) {
ret = db_create(&dbp, envp, 0);
if (ret) {
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"db_create");
goto error;
}
dbp->set_errpfx(dbp, "DbRename");
dbp->set_errcall(dbp, _ErrorFunc);
if (passwd != NULL) {
ret = dbp->set_encrypt(dbp, passwd, enc_flag);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"set_encrypt");
}
if (set_flags != 0) {
ret = dbp->set_flags(dbp, set_flags);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"set_flags");
}
}
_debug_check();
if (dbp == NULL)
ret = envp->dbrename(envp, txn, db, subdb, newname, iflags);
else
ret = dbp->rename(dbp, db, subdb, newname, 0);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db rename");
dbp = NULL;
error:
if (subdb)
__os_free(envp, subdb);
if (newname)
__os_free(envp, newname);
if (result == TCL_ERROR && dbp != NULL)
(void)dbp->close(dbp, 0);
return (result);
}
#ifdef CONFIG_TEST
static int
bdb_DbVerify(interp, objc, objv)
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
static const char *bdbverify[] = {
"-encrypt",
"-encryptaes",
"-encryptany",
"-env",
"-errfile",
"-errpfx",
"-noorderchk",
"-orderchkonly",
"-unref",
"--",
NULL
};
enum bdbvrfy {
TCL_DBVRFY_ENCRYPT,
TCL_DBVRFY_ENCRYPT_AES,
TCL_DBVRFY_ENCRYPT_ANY,
TCL_DBVRFY_ENV,
TCL_DBVRFY_ERRFILE,
TCL_DBVRFY_ERRPFX,
TCL_DBVRFY_NOORDERCHK,
TCL_DBVRFY_ORDERCHKONLY,
TCL_DBVRFY_UNREF,
TCL_DBVRFY_ENDARG
};
DB_ENV *envp;
DB *dbp;
FILE *errf;
u_int32_t enc_flag, flags, set_flags;
int endarg, i, optindex, result, ret, subdblen;
char *arg, *db, *errpfx, *passwd, *subdb;
u_char *subdbtmp;
envp = NULL;
dbp = NULL;
passwd = NULL;
result = TCL_OK;
db = errpfx = subdb = NULL;
errf = NULL;
flags = endarg = 0;
enc_flag = set_flags = 0;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 2, objv, "?args? filename");
return (TCL_ERROR);
}
i = 2;
while (i < objc) {
if (Tcl_GetIndexFromObj(interp, objv[i], bdbverify,
"option", TCL_EXACT, &optindex) != TCL_OK) {
arg = Tcl_GetStringFromObj(objv[i], NULL);
if (arg[0] == '-') {
result = IS_HELP(objv[i]);
goto error;
} else
Tcl_ResetResult(interp);
break;
}
i++;
switch ((enum bdbvrfy)optindex) {
case TCL_DBVRFY_ENCRYPT:
set_flags |= DB_ENCRYPT;
_debug_check();
break;
case TCL_DBVRFY_ENCRYPT_AES:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-encryptaes passwd?");
result = TCL_ERROR;
break;
}
passwd = Tcl_GetStringFromObj(objv[i++], NULL);
enc_flag = DB_ENCRYPT_AES;
break;
case TCL_DBVRFY_ENCRYPT_ANY:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-encryptany passwd?");
result = TCL_ERROR;
break;
}
passwd = Tcl_GetStringFromObj(objv[i++], NULL);
enc_flag = 0;
break;
case TCL_DBVRFY_ENV:
arg = Tcl_GetStringFromObj(objv[i++], NULL);
envp = NAME_TO_ENV(arg);
if (envp == NULL) {
Tcl_SetResult(interp,
"db verify: illegal environment",
TCL_STATIC);
result = TCL_ERROR;
break;
}
break;
case TCL_DBVRFY_ERRFILE:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"-errfile file");
result = TCL_ERROR;
break;
}
arg = Tcl_GetStringFromObj(objv[i++], NULL);
if (errf != NULL && errf != stdout && errf != stderr)
(void)fclose(errf);
if (strcmp(arg, "/dev/stdout") == 0)
errf = stdout;
else if (strcmp(arg, "/dev/stderr") == 0)
errf = stderr;
else
errf = fopen(arg, "a");
break;
case TCL_DBVRFY_ERRPFX:
if (i >= objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"-errpfx prefix");
result = TCL_ERROR;
break;
}
arg = Tcl_GetStringFromObj(objv[i++], NULL);
if (errpfx != NULL)
__os_free(envp, errpfx);
if ((ret = __os_strdup(NULL, arg, &errpfx)) != 0) {
result = _ReturnSetup(interp, ret,
DB_RETOK_STD(ret), "__os_strdup");
break;
}
break;
case TCL_DBVRFY_NOORDERCHK:
flags |= DB_NOORDERCHK;
break;
case TCL_DBVRFY_ORDERCHKONLY:
flags |= DB_ORDERCHKONLY;
break;
case TCL_DBVRFY_UNREF:
flags |= DB_UNREF;
break;
case TCL_DBVRFY_ENDARG:
endarg = 1;
break;
}
if (result != TCL_OK)
goto error;
if (endarg)
break;
}
if (result != TCL_OK)
goto error;
if (i != objc) {
db = Tcl_GetStringFromObj(objv[i++], NULL);
if (strcmp(db, "") == 0)
db = NULL;
if (i != objc) {
subdbtmp =
Tcl_GetByteArrayFromObj(objv[i++], &subdblen);
if ((ret = __os_malloc(envp,
(size_t)subdblen + 1, &subdb)) != 0) {
Tcl_SetResult(interp, db_strerror(ret),
TCL_STATIC);
return (0);
}
memcpy(subdb, subdbtmp, (size_t)subdblen);
subdb[subdblen] = '\0';
}
} else {
Tcl_WrongNumArgs(interp, 2, objv, "?args? filename");
result = TCL_ERROR;
goto error;
}
ret = db_create(&dbp, envp, 0);
if (ret) {
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"db_create");
goto error;
}
if (passwd != NULL) {
ret = dbp->set_encrypt(dbp, passwd, enc_flag);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"set_encrypt");
}
if (set_flags != 0) {
ret = dbp->set_flags(dbp, set_flags);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"set_flags");
}
if (errf != NULL)
dbp->set_errfile(dbp, errf);
if (errpfx != NULL)
dbp->set_errpfx(dbp, errpfx);
ret = dbp->verify(dbp, db, subdb, NULL, flags);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db verify");
dbp = NULL;
error:
if (errf != NULL && errf != stdout && errf != stderr)
(void)fclose(errf);
if (errpfx != NULL)
__os_free(envp, errpfx);
if (dbp)
(void)dbp->close(dbp, 0);
return (result);
}
#endif
static int
bdb_Version(interp, objc, objv)
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
static const char *bdbver[] = {
"-string", NULL
};
enum bdbver {
TCL_VERSTRING
};
int i, optindex, maj, min, patch, result, string, verobjc;
char *arg, *v;
Tcl_Obj *res, *verobjv[3];
result = TCL_OK;
string = 0;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 2, objv, "?args?");
return (TCL_ERROR);
}
i = 2;
while (i < objc) {
if (Tcl_GetIndexFromObj(interp, objv[i], bdbver,
"option", TCL_EXACT, &optindex) != TCL_OK) {
arg = Tcl_GetStringFromObj(objv[i], NULL);
if (arg[0] == '-') {
result = IS_HELP(objv[i]);
goto error;
} else
Tcl_ResetResult(interp);
break;
}
i++;
switch ((enum bdbver)optindex) {
case TCL_VERSTRING:
string = 1;
break;
}
if (result != TCL_OK)
goto error;
}
if (result != TCL_OK)
goto error;
v = db_version(&maj, &min, &patch);
if (string)
res = NewStringObj(v, strlen(v));
else {
verobjc = 3;
verobjv[0] = Tcl_NewIntObj(maj);
verobjv[1] = Tcl_NewIntObj(min);
verobjv[2] = Tcl_NewIntObj(patch);
res = Tcl_NewListObj(verobjc, verobjv);
}
Tcl_SetObjResult(interp, res);
error:
return (result);
}
#ifdef CONFIG_TEST
#define ADD_CONFIG_NAME(name) \
conf = NewStringObj(name, strlen(name)); \
if (Tcl_ListObjAppendElement(interp, res, conf) != TCL_OK) \
return (TCL_ERROR);
static int
bdb_GetConfig(interp, objc, objv)
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
Tcl_Obj *res, *conf;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, "");
return (TCL_ERROR);
}
res = Tcl_NewListObj(0, NULL);
conf = NULL;
#ifdef DEBUG
ADD_CONFIG_NAME("debug");
#endif
#ifdef DEBUG_ROP
ADD_CONFIG_NAME("debug_rop");
#endif
#ifdef DEBUG_WOP
ADD_CONFIG_NAME("debug_wop");
#endif
#ifdef HAVE_HASH
ADD_CONFIG_NAME("hash");
#endif
#ifdef HAVE_QUEUE
ADD_CONFIG_NAME("queue");
#endif
#ifdef HAVE_REPLICATION
ADD_CONFIG_NAME("rep");
#endif
#ifdef HAVE_REPLICATION_THREADS
ADD_CONFIG_NAME("repmgr");
#endif
#ifdef HAVE_RPC
ADD_CONFIG_NAME("rpc");
#endif
#ifdef HAVE_VERIFY
ADD_CONFIG_NAME("verify");
#endif
Tcl_SetObjResult(interp, res);
return (TCL_OK);
}
static int
bdb_Handles(interp, objc, objv)
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
DBTCL_INFO *p;
Tcl_Obj *res, *handle;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, "");
return (TCL_ERROR);
}
res = Tcl_NewListObj(0, NULL);
LIST_FOREACH(p, &__db_infohead, entries) {
handle = NewStringObj(p->i_name, strlen(p->i_name));
if (Tcl_ListObjAppendElement(interp, res, handle) != TCL_OK)
return (TCL_ERROR);
}
Tcl_SetObjResult(interp, res);
return (TCL_OK);
}
static int
bdb_MsgType(interp, objc, objv)
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
REP_CONTROL *rp;
Tcl_Obj *msgname;
u_int32_t len, msgtype;
int freerp, ret;
static const char *msgnames[] = {
"no_type", "alive", "alive_req", "all_req",
"bulk_log", "bulk_page",
"dupmaster", "file", "file_fail", "file_req", "lease_grant",
"log", "log_more", "log_req", "master_req", "newclient",
"newfile", "newmaster", "newsite", "page",
"page_fail", "page_more", "page_req",
"rerequest", "startsync", "update", "update_req",
"verify", "verify_fail", "verify_req",
"vote1", "vote2", NULL
};
if (objc != 3) {
Tcl_WrongNumArgs(interp, 3, objv, "msgtype msg");
return (TCL_ERROR);
}
ret = _CopyObjBytes(interp, objv[2], &rp, &len, &freerp);
if (ret != TCL_OK) {
Tcl_SetResult(interp,
"msgtype: bad control message", TCL_STATIC);
return (TCL_ERROR);
}
msgtype = rp->rectype;
msgname = NewStringObj(msgnames[msgtype], strlen(msgnames[msgtype]));
Tcl_SetObjResult(interp, msgname);
if (rp != NULL && freerp)
__os_free(NULL, rp);
return (TCL_OK);
}
static int
bdb_DbUpgrade(interp, objc, objv)
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
static const char *bdbupg[] = {
"-dupsort", "-env", "--", NULL
};
enum bdbupg {
TCL_DBUPG_DUPSORT,
TCL_DBUPG_ENV,
TCL_DBUPG_ENDARG
};
DB_ENV *envp;
DB *dbp;
u_int32_t flags;
int endarg, i, optindex, result, ret;
char *arg, *db;
envp = NULL;
dbp = NULL;
result = TCL_OK;
db = NULL;
flags = endarg = 0;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 2, objv, "?args? filename");
return (TCL_ERROR);
}
i = 2;
while (i < objc) {
if (Tcl_GetIndexFromObj(interp, objv[i], bdbupg,
"option", TCL_EXACT, &optindex) != TCL_OK) {
arg = Tcl_GetStringFromObj(objv[i], NULL);
if (arg[0] == '-') {
result = IS_HELP(objv[i]);
goto error;
} else
Tcl_ResetResult(interp);
break;
}
i++;
switch ((enum bdbupg)optindex) {
case TCL_DBUPG_DUPSORT:
flags |= DB_DUPSORT;
break;
case TCL_DBUPG_ENV:
arg = Tcl_GetStringFromObj(objv[i++], NULL);
envp = NAME_TO_ENV(arg);
if (envp == NULL) {
Tcl_SetResult(interp,
"db upgrade: illegal environment",
TCL_STATIC);
return (TCL_ERROR);
}
break;
case TCL_DBUPG_ENDARG:
endarg = 1;
break;
}
if (result != TCL_OK)
goto error;
if (endarg)
break;
}
if (result != TCL_OK)
goto error;
if (i == (objc - 1))
db = Tcl_GetStringFromObj(objv[i++], NULL);
else {
Tcl_WrongNumArgs(interp, 2, objv, "?args? filename");
result = TCL_ERROR;
goto error;
}
ret = db_create(&dbp, envp, 0);
if (ret) {
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"db_create");
goto error;
}
if (envp == NULL) {
dbp->set_errpfx(dbp, "DbUpgrade");
dbp->set_errcall(dbp, _ErrorFunc);
}
ret = dbp->upgrade(dbp, db, flags);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db upgrade");
error:
if (dbp)
(void)dbp->close(dbp, 0);
return (result);
}
static int
tcl_bt_compare(dbp, dbta, dbtb)
DB *dbp;
const DBT *dbta, *dbtb;
{
return (tcl_compare_callback(dbp, dbta, dbtb,
((DBTCL_INFO *)dbp->api_internal)->i_compare, "bt_compare"));
}
static int
tcl_dup_compare(dbp, dbta, dbtb)
DB *dbp;
const DBT *dbta, *dbtb;
{
return (tcl_compare_callback(dbp, dbta, dbtb,
((DBTCL_INFO *)dbp->api_internal)->i_dupcompare, "dup_compare"));
}
static int
tcl_compare_callback(dbp, dbta, dbtb, procobj, errname)
DB *dbp;
const DBT *dbta, *dbtb;
Tcl_Obj *procobj;
char *errname;
{
DBTCL_INFO *ip;
Tcl_Interp *interp;
Tcl_Obj *a, *b, *resobj, *objv[3];
int result, cmp;
ip = (DBTCL_INFO *)dbp->api_internal;
interp = ip->i_interp;
objv[0] = procobj;
a = Tcl_NewByteArrayObj(dbta->data, (int)dbta->size);
Tcl_IncrRefCount(a);
b = Tcl_NewByteArrayObj(dbtb->data, (int)dbtb->size);
Tcl_IncrRefCount(b);
objv[1] = a;
objv[2] = b;
result = Tcl_EvalObjv(interp, 3, objv, 0);
if (result != TCL_OK) {
panic: __db_errx(dbp->dbenv, "Tcl %s callback failed", errname);
return (__db_panic(dbp->dbenv, DB_RUNRECOVERY));
}
resobj = Tcl_GetObjResult(interp);
result = Tcl_GetIntFromObj(interp, resobj, &cmp);
if (result != TCL_OK)
goto panic;
Tcl_DecrRefCount(a);
Tcl_DecrRefCount(b);
return (cmp);
}
static u_int32_t
tcl_h_hash(dbp, buf, len)
DB *dbp;
const void *buf;
u_int32_t len;
{
DBTCL_INFO *ip;
Tcl_Interp *interp;
Tcl_Obj *objv[2];
int result, hval;
ip = (DBTCL_INFO *)dbp->api_internal;
interp = ip->i_interp;
objv[0] = ip->i_hashproc;
objv[1] = Tcl_NewByteArrayObj((void *)buf, (int)len);
Tcl_IncrRefCount(objv[1]);
result = Tcl_EvalObjv(interp, 2, objv, 0);
if (result != TCL_OK)
goto panic;
result = Tcl_GetIntFromObj(interp, Tcl_GetObjResult(interp), &hval);
if (result != TCL_OK)
goto panic;
Tcl_DecrRefCount(objv[1]);
return ((u_int32_t)hval);
panic: __db_errx(dbp->dbenv, "Tcl h_hash callback failed");
(void)__db_panic(dbp->dbenv, DB_RUNRECOVERY);
return (0);
}
int
tcl_rep_send(dbenv, control, rec, lsnp, eid, flags)
DB_ENV *dbenv;
const DBT *control, *rec;
const DB_LSN *lsnp;
int eid;
u_int32_t flags;
{
#define TCLDB_SENDITEMS 7
#define TCLDB_MAXREPFLAGS 32
DBTCL_INFO *ip;
Tcl_Interp *interp;
Tcl_Obj *control_o, *eid_o, *flags_o, *lsn_o, *origobj, *rec_o;
Tcl_Obj *lsnobj[2], *myobjv[TCLDB_MAXREPFLAGS], *objv[TCLDB_SENDITEMS];
Tcl_Obj *resobj;
int i, myobjc, result, ret;
ip = (DBTCL_INFO *)dbenv->app_private;
interp = ip->i_interp;
objv[0] = ip->i_rep_send;
control_o = Tcl_NewByteArrayObj(control->data, (int)control->size);
Tcl_IncrRefCount(control_o);
rec_o = Tcl_NewByteArrayObj(rec->data, (int)rec->size);
Tcl_IncrRefCount(rec_o);
eid_o = Tcl_NewIntObj(eid);
Tcl_IncrRefCount(eid_o);
myobjv[myobjc = 0] = NULL;
if (flags == 0)
myobjv[myobjc++] = NewStringObj("none", strlen("none"));
if (LF_ISSET(DB_REP_ANYWHERE))
myobjv[myobjc++] = NewStringObj("any", strlen("any"));
if (LF_ISSET(DB_REP_NOBUFFER))
myobjv[myobjc++] = NewStringObj("nobuffer", strlen("nobuffer"));
if (LF_ISSET(DB_REP_PERMANENT))
myobjv[myobjc++] = NewStringObj("perm", strlen("perm"));
if (LF_ISSET(DB_REP_REREQUEST))
myobjv[myobjc++] =
NewStringObj("rerequest", strlen("rerequest"));
if (myobjc == 0)
myobjv[myobjc++] = NewStringObj("unknown", strlen("unknown"));
for (i = 0; i < myobjc; i++)
Tcl_IncrRefCount(myobjv[i]);
flags_o = Tcl_NewListObj(myobjc, myobjv);
Tcl_IncrRefCount(flags_o);
lsnobj[0] = Tcl_NewLongObj((long)lsnp->file);
Tcl_IncrRefCount(lsnobj[0]);
lsnobj[1] = Tcl_NewLongObj((long)lsnp->offset);
Tcl_IncrRefCount(lsnobj[1]);
lsn_o = Tcl_NewListObj(2, lsnobj);
Tcl_IncrRefCount(lsn_o);
objv[1] = control_o;
objv[2] = rec_o;
objv[3] = ip->i_rep_eid;
objv[4] = eid_o;
objv[5] = flags_o;
objv[6] = lsn_o;
origobj = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(origobj);
result = Tcl_EvalObjv(interp, TCLDB_SENDITEMS, objv, 0);
if (result != TCL_OK) {
err: __db_errx(dbenv, "Tcl rep_send failure: %s",
Tcl_GetStringResult(interp));
return (EINVAL);
}
resobj = Tcl_GetObjResult(interp);
result = Tcl_GetIntFromObj(interp, resobj, &ret);
if (result != TCL_OK)
goto err;
Tcl_SetObjResult(interp, origobj);
Tcl_DecrRefCount(origobj);
Tcl_DecrRefCount(control_o);
Tcl_DecrRefCount(rec_o);
Tcl_DecrRefCount(eid_o);
for (i = 0; i < myobjc; i++)
Tcl_DecrRefCount(myobjv[i]);
Tcl_DecrRefCount(flags_o);
Tcl_DecrRefCount(lsnobj[0]);
Tcl_DecrRefCount(lsnobj[1]);
Tcl_DecrRefCount(lsn_o);
return (ret);
}
#endif
#ifdef CONFIG_TEST
static void *
tcl_db_malloc(size)
size_t size;
{
Tcl_Obj *obj;
void *buf;
obj = Tcl_NewObj();
if (obj == NULL)
return (NULL);
Tcl_IncrRefCount(obj);
Tcl_SetObjLength(obj, (int)(size + sizeof(Tcl_Obj *)));
buf = Tcl_GetString(obj);
memcpy(buf, &obj, sizeof(&obj));
buf = (Tcl_Obj **)buf + 1;
return (buf);
}
static void *
tcl_db_realloc(ptr, size)
void *ptr;
size_t size;
{
Tcl_Obj *obj;
if (ptr == NULL)
return (tcl_db_malloc(size));
obj = *(Tcl_Obj **)((Tcl_Obj **)ptr - 1);
Tcl_SetObjLength(obj, (int)(size + sizeof(Tcl_Obj *)));
ptr = Tcl_GetString(obj);
memcpy(ptr, &obj, sizeof(&obj));
ptr = (Tcl_Obj **)ptr + 1;
return (ptr);
}
static void
tcl_db_free(ptr)
void *ptr;
{
Tcl_Obj *obj;
obj = *(Tcl_Obj **)((Tcl_Obj **)ptr - 1);
Tcl_DecrRefCount(obj);
}
#endif