diff options
| author | unknown <ram@mysql.r18.ru> | 2002-10-30 15:57:05 +0400 |
|---|---|---|
| committer | unknown <ram@mysql.r18.ru> | 2002-10-30 15:57:05 +0400 |
| commit | 155e78f014de1a2e259ae5119f4621fbb210a784 (patch) | |
| tree | 6881a3cca88bea0bb9eeffd5aae34be437152786 /bdb/tcl/tcl_db_pkg.c | |
| parent | b8798d25ab71436bf690ee8ae48285a655c5487e (diff) | |
| download | mariadb-git-155e78f014de1a2e259ae5119f4621fbb210a784.tar.gz | |
BDB 4.1.24
BitKeeper/deleted/.del-ex_access.wpj~3df6ae8c99bf7c5f:
Delete: bdb/build_vxworks/ex_access/ex_access.wpj
BitKeeper/deleted/.del-ex_btrec.wpj~a7622f1c6f432dc6:
Delete: bdb/build_vxworks/ex_btrec/ex_btrec.wpj
BitKeeper/deleted/.del-ex_dbclient.wpj~7345440f3b204cdd:
Delete: bdb/build_vxworks/ex_dbclient/ex_dbclient.wpj
BitKeeper/deleted/.del-ex_env.wpj~fbe1ab10b04e8b74:
Delete: bdb/build_vxworks/ex_env/ex_env.wpj
BitKeeper/deleted/.del-ex_mpool.wpj~4479cfd5c45f327d:
Delete: bdb/build_vxworks/ex_mpool/ex_mpool.wpj
BitKeeper/deleted/.del-ex_tpcb.wpj~f78093006e14bf41:
Delete: bdb/build_vxworks/ex_tpcb/ex_tpcb.wpj
BitKeeper/deleted/.del-db_buildall.dsp~bd749ff6da11682:
Delete: bdb/build_win32/db_buildall.dsp
BitKeeper/deleted/.del-cxx_app.cpp~ad8df8e0791011ed:
Delete: bdb/cxx/cxx_app.cpp
BitKeeper/deleted/.del-cxx_log.cpp~a50ff3118fe06952:
Delete: bdb/cxx/cxx_log.cpp
BitKeeper/deleted/.del-cxx_table.cpp~ecd751e79b055556:
Delete: bdb/cxx/cxx_table.cpp
BitKeeper/deleted/.del-namemap.txt~796a3acd3885d8fd:
Delete: bdb/cxx/namemap.txt
BitKeeper/deleted/.del-Design.fileop~3ca4da68f1727373:
Delete: bdb/db/Design.fileop
BitKeeper/deleted/.del-db185_int.h~61bee3736e7959ef:
Delete: bdb/db185/db185_int.h
BitKeeper/deleted/.del-acconfig.h~411e8854d67ad8b5:
Delete: bdb/dist/acconfig.h
BitKeeper/deleted/.del-mutex.m4~a13383cde18a64e1:
Delete: bdb/dist/aclocal/mutex.m4
BitKeeper/deleted/.del-options.m4~b9d0ca637213750a:
Delete: bdb/dist/aclocal/options.m4
BitKeeper/deleted/.del-programs.m4~3ce7890b47732b30:
Delete: bdb/dist/aclocal/programs.m4
BitKeeper/deleted/.del-tcl.m4~f944e2db93c3b6db:
Delete: bdb/dist/aclocal/tcl.m4
BitKeeper/deleted/.del-types.m4~59cae158c9a32cff:
Delete: bdb/dist/aclocal/types.m4
BitKeeper/deleted/.del-script~d38f6d3a4f159cb4:
Delete: bdb/dist/build/script
BitKeeper/deleted/.del-configure.in~ac795a92c8fe049c:
Delete: bdb/dist/configure.in
BitKeeper/deleted/.del-ltconfig~66bbd007d8024af:
Delete: bdb/dist/ltconfig
BitKeeper/deleted/.del-rec_ctemp~a28554362534f00a:
Delete: bdb/dist/rec_ctemp
BitKeeper/deleted/.del-s_tcl~2ffe4326459fcd9f:
Delete: bdb/dist/s_tcl
BitKeeper/deleted/.del-.IGNORE_ME~d8148b08fa7d5d15:
Delete: bdb/dist/template/.IGNORE_ME
BitKeeper/deleted/.del-btree.h~179f2aefec1753d:
Delete: bdb/include/btree.h
BitKeeper/deleted/.del-cxx_int.h~6b649c04766508f8:
Delete: bdb/include/cxx_int.h
BitKeeper/deleted/.del-db.src~6b433ae615b16a8d:
Delete: bdb/include/db.src
BitKeeper/deleted/.del-db_185.h~ad8b373d9391d35c:
Delete: bdb/include/db_185.h
BitKeeper/deleted/.del-db_am.h~a714912b6b75932f:
Delete: bdb/include/db_am.h
BitKeeper/deleted/.del-db_cxx.h~fcafadf45f5d19e9:
Delete: bdb/include/db_cxx.h
BitKeeper/deleted/.del-db_dispatch.h~6844f20f7eb46904:
Delete: bdb/include/db_dispatch.h
BitKeeper/deleted/.del-db_int.src~419a3f48b6a01da7:
Delete: bdb/include/db_int.src
BitKeeper/deleted/.del-db_join.h~76f9747a42c3399a:
Delete: bdb/include/db_join.h
BitKeeper/deleted/.del-db_page.h~e302ca3a4db3abdc:
Delete: bdb/include/db_page.h
BitKeeper/deleted/.del-db_server_int.h~e1d20b6ba3bca1ab:
Delete: bdb/include/db_server_int.h
BitKeeper/deleted/.del-db_shash.h~5fbf2d696fac90f3:
Delete: bdb/include/db_shash.h
BitKeeper/deleted/.del-db_swap.h~1e60887550864a59:
Delete: bdb/include/db_swap.h
BitKeeper/deleted/.del-db_upgrade.h~c644eee73701fc8d:
Delete: bdb/include/db_upgrade.h
BitKeeper/deleted/.del-db_verify.h~b8d6c297c61f342e:
Delete: bdb/include/db_verify.h
BitKeeper/deleted/.del-debug.h~dc2b4f2cf27ccebc:
Delete: bdb/include/debug.h
BitKeeper/deleted/.del-hash.h~2aaa548b28882dfb:
Delete: bdb/include/hash.h
BitKeeper/deleted/.del-lock.h~a761c1b7de57b77f:
Delete: bdb/include/lock.h
BitKeeper/deleted/.del-log.h~ff20184238e35e4d:
Delete: bdb/include/log.h
BitKeeper/deleted/.del-mp.h~7e317597622f3411:
Delete: bdb/include/mp.h
BitKeeper/deleted/.del-mutex.h~d3ae7a2977a68137:
Delete: bdb/include/mutex.h
BitKeeper/deleted/.del-os.h~91867cc8757cd0e3:
Delete: bdb/include/os.h
BitKeeper/deleted/.del-os_jump.h~e1b939fa5151d4be:
Delete: bdb/include/os_jump.h
BitKeeper/deleted/.del-qam.h~6fad0c1b5723d597:
Delete: bdb/include/qam.h
BitKeeper/deleted/.del-queue.h~4c72c0826c123d5:
Delete: bdb/include/queue.h
BitKeeper/deleted/.del-region.h~513fe04d977ca0fc:
Delete: bdb/include/region.h
BitKeeper/deleted/.del-shqueue.h~525fc3e6c2025c36:
Delete: bdb/include/shqueue.h
BitKeeper/deleted/.del-tcl_db.h~c536fd61a844f23f:
Delete: bdb/include/tcl_db.h
BitKeeper/deleted/.del-txn.h~c8d94b221ec147e4:
Delete: bdb/include/txn.h
BitKeeper/deleted/.del-xa.h~ecc466493aae9d9a:
Delete: bdb/include/xa.h
BitKeeper/deleted/.del-DbRecoveryInit.java~756b52601a0b9023:
Delete: bdb/java/src/com/sleepycat/db/DbRecoveryInit.java
BitKeeper/deleted/.del-DbTxnRecover.java~74607cba7ab89d6d:
Delete: bdb/java/src/com/sleepycat/db/DbTxnRecover.java
BitKeeper/deleted/.del-lock_conflict.c~fc5e0f14cf597a2b:
Delete: bdb/lock/lock_conflict.c
BitKeeper/deleted/.del-log.src~53ac9e7b5cb023f2:
Delete: bdb/log/log.src
BitKeeper/deleted/.del-log_findckp.c~24287f008916e81f:
Delete: bdb/log/log_findckp.c
BitKeeper/deleted/.del-log_rec.c~d51711f2cac09297:
Delete: bdb/log/log_rec.c
BitKeeper/deleted/.del-log_register.c~b40bb4efac75ca15:
Delete: bdb/log/log_register.c
BitKeeper/deleted/.del-Design~b3d0f179f2767b:
Delete: bdb/mp/Design
BitKeeper/deleted/.del-os_finit.c~95dbefc6fe79b26c:
Delete: bdb/os/os_finit.c
BitKeeper/deleted/.del-os_abs.c~df95d1e7db81924:
Delete: bdb/os_vxworks/os_abs.c
BitKeeper/deleted/.del-os_finit.c~803b484bdb9d0122:
Delete: bdb/os_vxworks/os_finit.c
BitKeeper/deleted/.del-os_map.c~3a6d7926398b76d3:
Delete: bdb/os_vxworks/os_map.c
BitKeeper/deleted/.del-os_finit.c~19a227c6d3c78ad:
Delete: bdb/os_win32/os_finit.c
BitKeeper/deleted/.del-log-corruption.patch~1cf2ecc7c6408d5d:
Delete: bdb/patches/log-corruption.patch
BitKeeper/deleted/.del-Btree.pm~af6d0c5eaed4a98e:
Delete: bdb/perl.BerkeleyDB/BerkeleyDB/Btree.pm
BitKeeper/deleted/.del-BerkeleyDB.pm~7244036d4482643:
Delete: bdb/perl.BerkeleyDB/BerkeleyDB.pm
BitKeeper/deleted/.del-BerkeleyDB.pod~e7b18fd6132448e3:
Delete: bdb/perl.BerkeleyDB/BerkeleyDB.pod
BitKeeper/deleted/.del-Hash.pm~10292a26c06a5c95:
Delete: bdb/perl.BerkeleyDB/BerkeleyDB/Hash.pm
BitKeeper/deleted/.del-BerkeleyDB.pod.P~79f76a1495eda203:
Delete: bdb/perl.BerkeleyDB/BerkeleyDB.pod.P
BitKeeper/deleted/.del-BerkeleyDB.xs~80c99afbd98e392c:
Delete: bdb/perl.BerkeleyDB/BerkeleyDB.xs
BitKeeper/deleted/.del-Changes~729c1891efa60de9:
Delete: bdb/perl.BerkeleyDB/Changes
BitKeeper/deleted/.del-MANIFEST~63a1e34aecf157a0:
Delete: bdb/perl.BerkeleyDB/MANIFEST
BitKeeper/deleted/.del-Makefile.PL~c68797707d8df87a:
Delete: bdb/perl.BerkeleyDB/Makefile.PL
BitKeeper/deleted/.del-README~5f2f579b1a241407:
Delete: bdb/perl.BerkeleyDB/README
BitKeeper/deleted/.del-Todo~dca3c66c193adda9:
Delete: bdb/perl.BerkeleyDB/Todo
BitKeeper/deleted/.del-config.in~ae81681e450e0999:
Delete: bdb/perl.BerkeleyDB/config.in
BitKeeper/deleted/.del-dbinfo~28ad67d83be4f68e:
Delete: bdb/perl.BerkeleyDB/dbinfo
BitKeeper/deleted/.del-mkconsts~543ab60669c7a04e:
Delete: bdb/perl.BerkeleyDB/mkconsts
BitKeeper/deleted/.del-mkpod~182c0ca54e439afb:
Delete: bdb/perl.BerkeleyDB/mkpod
BitKeeper/deleted/.del-5.004~e008cb5a48805543:
Delete: bdb/perl.BerkeleyDB/patches/5.004
BitKeeper/deleted/.del-irix_6_5.pl~61662bb08afcdec8:
Delete: bdb/perl.BerkeleyDB/hints/irix_6_5.pl
BitKeeper/deleted/.del-solaris.pl~6771e7182394e152:
Delete: bdb/perl.BerkeleyDB/hints/solaris.pl
BitKeeper/deleted/.del-typemap~783b8f5295b05f3d:
Delete: bdb/perl.BerkeleyDB/typemap
BitKeeper/deleted/.del-5.004_01~6081ce2fff7b0bc:
Delete: bdb/perl.BerkeleyDB/patches/5.004_01
BitKeeper/deleted/.del-5.004_02~87214eac35ad9e6:
Delete: bdb/perl.BerkeleyDB/patches/5.004_02
BitKeeper/deleted/.del-5.004_03~9a672becec7cb40f:
Delete: bdb/perl.BerkeleyDB/patches/5.004_03
BitKeeper/deleted/.del-5.004_04~e326cb51af09d154:
Delete: bdb/perl.BerkeleyDB/patches/5.004_04
BitKeeper/deleted/.del-5.004_05~7ab457a1e41a92fe:
Delete: bdb/perl.BerkeleyDB/patches/5.004_05
BitKeeper/deleted/.del-5.005~f9e2d59b5964cd4b:
Delete: bdb/perl.BerkeleyDB/patches/5.005
BitKeeper/deleted/.del-5.005_01~3eb9fb7b5842ea8e:
Delete: bdb/perl.BerkeleyDB/patches/5.005_01
BitKeeper/deleted/.del-5.005_02~67477ce0bef717cb:
Delete: bdb/perl.BerkeleyDB/patches/5.005_02
BitKeeper/deleted/.del-5.005_03~c4c29a1fb21e290a:
Delete: bdb/perl.BerkeleyDB/patches/5.005_03
BitKeeper/deleted/.del-5.6.0~e1fb9897d124ee22:
Delete: bdb/perl.BerkeleyDB/patches/5.6.0
BitKeeper/deleted/.del-btree.t~e4a1a3c675ddc406:
Delete: bdb/perl.BerkeleyDB/t/btree.t
BitKeeper/deleted/.del-db-3.0.t~d2c60991d84558f2:
Delete: bdb/perl.BerkeleyDB/t/db-3.0.t
BitKeeper/deleted/.del-db-3.1.t~6ee88cd13f55e018:
Delete: bdb/perl.BerkeleyDB/t/db-3.1.t
BitKeeper/deleted/.del-db-3.2.t~f73b6461f98fd1cf:
Delete: bdb/perl.BerkeleyDB/t/db-3.2.t
BitKeeper/deleted/.del-destroy.t~cc6a2ae1980a2ecd:
Delete: bdb/perl.BerkeleyDB/t/destroy.t
BitKeeper/deleted/.del-env.t~a8604a4499c4bd07:
Delete: bdb/perl.BerkeleyDB/t/env.t
BitKeeper/deleted/.del-examples.t~2571b77c3cc75574:
Delete: bdb/perl.BerkeleyDB/t/examples.t
BitKeeper/deleted/.del-examples.t.T~8228bdd75ac78b88:
Delete: bdb/perl.BerkeleyDB/t/examples.t.T
BitKeeper/deleted/.del-examples3.t.T~66a186897a87026d:
Delete: bdb/perl.BerkeleyDB/t/examples3.t.T
BitKeeper/deleted/.del-examples3.t~fe3822ba2f2d7f83:
Delete: bdb/perl.BerkeleyDB/t/examples3.t
BitKeeper/deleted/.del-filter.t~f87b045c1b708637:
Delete: bdb/perl.BerkeleyDB/t/filter.t
BitKeeper/deleted/.del-hash.t~616bfb4d644de3a3:
Delete: bdb/perl.BerkeleyDB/t/hash.t
BitKeeper/deleted/.del-join.t~29fc39f74a83ca22:
Delete: bdb/perl.BerkeleyDB/t/join.t
BitKeeper/deleted/.del-mldbm.t~31f5015341eea040:
Delete: bdb/perl.BerkeleyDB/t/mldbm.t
BitKeeper/deleted/.del-queue.t~8f338034ce44a641:
Delete: bdb/perl.BerkeleyDB/t/queue.t
BitKeeper/deleted/.del-recno.t~d4ddbd3743add63e:
Delete: bdb/perl.BerkeleyDB/t/recno.t
BitKeeper/deleted/.del-strict.t~6885cdd2ea71ca2d:
Delete: bdb/perl.BerkeleyDB/t/strict.t
BitKeeper/deleted/.del-subdb.t~aab62a5d5864c603:
Delete: bdb/perl.BerkeleyDB/t/subdb.t
BitKeeper/deleted/.del-txn.t~65033b8558ae1216:
Delete: bdb/perl.BerkeleyDB/t/txn.t
BitKeeper/deleted/.del-unknown.t~f3710458682665e1:
Delete: bdb/perl.BerkeleyDB/t/unknown.t
BitKeeper/deleted/.del-Changes~436f74a5c414c65b:
Delete: bdb/perl.DB_File/Changes
BitKeeper/deleted/.del-DB_File.pm~ae0951c6c7665a82:
Delete: bdb/perl.DB_File/DB_File.pm
BitKeeper/deleted/.del-DB_File.xs~89e49a0b5556f1d8:
Delete: bdb/perl.DB_File/DB_File.xs
BitKeeper/deleted/.del-DB_File_BS~290fad5dbbb87069:
Delete: bdb/perl.DB_File/DB_File_BS
BitKeeper/deleted/.del-MANIFEST~90ee581572bdd4ac:
Delete: bdb/perl.DB_File/MANIFEST
BitKeeper/deleted/.del-Makefile.PL~ac0567bb5a377e38:
Delete: bdb/perl.DB_File/Makefile.PL
BitKeeper/deleted/.del-README~77e924a5a9bae6b3:
Delete: bdb/perl.DB_File/README
BitKeeper/deleted/.del-config.in~ab4c2792b86a810b:
Delete: bdb/perl.DB_File/config.in
BitKeeper/deleted/.del-dbinfo~461c43b30fab2cb:
Delete: bdb/perl.DB_File/dbinfo
BitKeeper/deleted/.del-dynixptx.pl~50dcddfae25d17e9:
Delete: bdb/perl.DB_File/hints/dynixptx.pl
BitKeeper/deleted/.del-typemap~55cffb3288a9e587:
Delete: bdb/perl.DB_File/typemap
BitKeeper/deleted/.del-version.c~a4df0e646f8b3975:
Delete: bdb/perl.DB_File/version.c
BitKeeper/deleted/.del-5.004_01~d6830d0082702af7:
Delete: bdb/perl.DB_File/patches/5.004_01
BitKeeper/deleted/.del-5.004_02~78b082dc80c91031:
Delete: bdb/perl.DB_File/patches/5.004_02
BitKeeper/deleted/.del-5.004~4411ec2e3c9e008b:
Delete: bdb/perl.DB_File/patches/5.004
BitKeeper/deleted/.del-sco.pl~1e795fe14fe4dcfe:
Delete: bdb/perl.DB_File/hints/sco.pl
BitKeeper/deleted/.del-5.004_03~33f274648b160d95:
Delete: bdb/perl.DB_File/patches/5.004_03
BitKeeper/deleted/.del-5.004_04~8f3d1b3cf18bb20a:
Delete: bdb/perl.DB_File/patches/5.004_04
BitKeeper/deleted/.del-5.004_05~9c0f02e7331e142:
Delete: bdb/perl.DB_File/patches/5.004_05
BitKeeper/deleted/.del-5.005~c2108cb2e3c8d951:
Delete: bdb/perl.DB_File/patches/5.005
BitKeeper/deleted/.del-5.005_01~3b45e9673afc4cfa:
Delete: bdb/perl.DB_File/patches/5.005_01
BitKeeper/deleted/.del-5.005_02~9fe5766bb02a4522:
Delete: bdb/perl.DB_File/patches/5.005_02
BitKeeper/deleted/.del-5.005_03~ffa1c38c19ae72ea:
Delete: bdb/perl.DB_File/patches/5.005_03
BitKeeper/deleted/.del-5.6.0~373be3a5ce47be85:
Delete: bdb/perl.DB_File/patches/5.6.0
BitKeeper/deleted/.del-db-btree.t~3231595a1c241eb3:
Delete: bdb/perl.DB_File/t/db-btree.t
BitKeeper/deleted/.del-db-hash.t~7c4ad0c795c7fad2:
Delete: bdb/perl.DB_File/t/db-hash.t
BitKeeper/deleted/.del-db-recno.t~6c2d3d80b9ba4a50:
Delete: bdb/perl.DB_File/t/db-recno.t
BitKeeper/deleted/.del-db_server.sed~cdb00ebcd48a64e2:
Delete: bdb/rpc_server/db_server.sed
BitKeeper/deleted/.del-db_server_proc.c~d46c8f409c3747f4:
Delete: bdb/rpc_server/db_server_proc.c
BitKeeper/deleted/.del-db_server_svc.sed~3f5e59f334fa4607:
Delete: bdb/rpc_server/db_server_svc.sed
BitKeeper/deleted/.del-db_server_util.c~a809f3a4629acda:
Delete: bdb/rpc_server/db_server_util.c
BitKeeper/deleted/.del-log.tcl~ff1b41f1355b97d7:
Delete: bdb/test/log.tcl
BitKeeper/deleted/.del-mpool.tcl~b0df4dc1b04db26c:
Delete: bdb/test/mpool.tcl
BitKeeper/deleted/.del-mutex.tcl~52fd5c73a150565:
Delete: bdb/test/mutex.tcl
BitKeeper/deleted/.del-txn.tcl~c4ff071550b5446e:
Delete: bdb/test/txn.tcl
BitKeeper/deleted/.del-README~e800a12a5392010a:
Delete: bdb/test/upgrade/README
BitKeeper/deleted/.del-pack-2.6.6.pl~89d5076d758d3e98:
Delete: bdb/test/upgrade/generate-2.X/pack-2.6.6.pl
BitKeeper/deleted/.del-test-2.6.patch~4a52dc83d447547b:
Delete: bdb/test/upgrade/generate-2.X/test-2.6.patch
Diffstat (limited to 'bdb/tcl/tcl_db_pkg.c')
| -rw-r--r-- | bdb/tcl/tcl_db_pkg.c | 1739 |
1 files changed, 1305 insertions, 434 deletions
diff --git a/bdb/tcl/tcl_db_pkg.c b/bdb/tcl/tcl_db_pkg.c index f83b5a7d2a9..ce37598dc1a 100644 --- a/bdb/tcl/tcl_db_pkg.c +++ b/bdb/tcl/tcl_db_pkg.c @@ -1,14 +1,14 @@ /*- * See the file LICENSE for redistribution information. * - * Copyright (c) 1999, 2000 + * Copyright (c) 1999-2002 * Sleepycat Software. All rights reserved. */ #include "db_config.h" #ifndef lint -static const char revid[] = "$Id: tcl_db_pkg.c,v 11.76 2001/01/19 18:02:36 bostic Exp $"; +static const char revid[] = "$Id: tcl_db_pkg.c,v 11.141 2002/08/14 20:15:47 bostic Exp $"; #endif /* not lint */ #ifndef NO_SYSTEM_INCLUDES @@ -19,10 +19,17 @@ static const char revid[] = "$Id: tcl_db_pkg.c,v 11.76 2001/01/19 18:02:36 bosti #include <tcl.h> #endif +#if CONFIG_TEST #define DB_DBM_HSEARCH 1 +#endif #include "db_int.h" -#include "tcl_db.h" +#include "dbinc/db_page.h" +#include "dbinc/hash.h" +#include "dbinc/tcl_db.h" + +/* XXX we must declare global data in just one place */ +DBTCL_GLOBAL __dbtcl_global; /* * Prototypes for procedures defined later in this file: @@ -40,6 +47,20 @@ static int bdb_DbVerify __P((Tcl_Interp *, int, Tcl_Obj * CONST*)); static int bdb_Version __P((Tcl_Interp *, int, Tcl_Obj * CONST*)); static int bdb_Handles __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 int tcl_dup_compare __P((DB *, const DBT *, const DBT *)); +static u_int32_t tcl_h_hash __P((DB *, const void *, u_int32_t)); +static int tcl_rep_send __P((DB_ENV *, + const DBT *, const DBT *, int, u_int32_t)); + +#ifdef TEST_ALLOC +static void * tcl_db_malloc __P((size_t)); +static void * tcl_db_realloc __P((void *, size_t)); +static void tcl_db_free __P((void *)); +#endif + /* * Db_tcl_Init -- * @@ -96,20 +117,24 @@ berkdb_Cmd(notused, interp, objc, objv) Tcl_Obj *CONST objv[]; /* The argument objects */ { static char *berkdbcmds[] = { +#if CONFIG_TEST + "dbverify", + "handles", + "upgrade", +#endif "dbremove", "dbrename", - "dbverify", "env", "envremove", - "handles", "open", - "upgrade", "version", +#if CONFIG_TEST /* All below are compatibility functions */ "hcreate", "hsearch", "hdestroy", "dbminit", "fetch", "store", "delete", "firstkey", "nextkey", "ndbm_open", "dbmclose", +#endif /* All below are convenience functions */ "rand", "random_int", "srand", "debug_check", @@ -119,28 +144,34 @@ berkdb_Cmd(notused, interp, objc, objv) * All commands enums below ending in X are compatibility */ enum berkdbcmds { +#if CONFIG_TEST + BDB_DBVERIFY, + BDB_HANDLES, + BDB_UPGRADE, +#endif BDB_DBREMOVE, BDB_DBRENAME, - BDB_DBVERIFY, BDB_ENV, BDB_ENVREMOVE, - BDB_HANDLES, BDB_OPEN, - BDB_UPGRADE, BDB_VERSION, +#if 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; - static int ndbm_id = 0; DB *dbp; +#if CONFIG_TEST DBM *ndbmp; + static int ndbm_id = 0; +#endif DBTCL_INFO *ip; DB_ENV *envp; Tcl_Obj *res; @@ -166,13 +197,21 @@ berkdb_Cmd(notused, interp, objc, objv) return (IS_HELP(objv[1])); res = NULL; switch ((enum berkdbcmds)cmdindex) { - case BDB_VERSION: - _debug_check(); - result = bdb_Version(interp, objc, objv); +#if CONFIG_TEST + case BDB_DBVERIFY: + result = bdb_DbVerify(interp, objc, objv); break; case BDB_HANDLES: result = bdb_Handles(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); @@ -201,12 +240,6 @@ berkdb_Cmd(notused, interp, objc, objv) case BDB_DBRENAME: result = bdb_DbRename(interp, objc, objv); break; - case BDB_UPGRADE: - result = bdb_DbUpgrade(interp, objc, objv); - break; - case BDB_DBVERIFY: - result = bdb_DbVerify(interp, objc, objv); - break; case BDB_ENVREMOVE: result = tcl_EnvRemove(interp, objc, objv, NULL, NULL); break; @@ -232,6 +265,7 @@ berkdb_Cmd(notused, interp, objc, objv) result = TCL_ERROR; } break; +#if CONFIG_TEST case BDB_HCREATEX: case BDB_HSEARCHX: case BDB_HDESTROYX: @@ -268,6 +302,7 @@ berkdb_Cmd(notused, interp, objc, objv) result = TCL_ERROR; } break; +#endif case BDB_RANDX: case BDB_RAND_INTX: case BDB_SRANDX: @@ -296,7 +331,7 @@ berkdb_Cmd(notused, interp, objc, objv) * 1. Call db_env_create to create the env handle. * 2. Parse args tracking options. * 3. Make any pre-open setup calls necessary. - * 4. Call DBENV->open to open the env. + * 4. Call DB_ENV->open to open the env. * 5. Return env widget handle to user. */ static int @@ -308,15 +343,11 @@ bdb_EnvOpen(interp, objc, objv, ip, env) DB_ENV **env; /* Environment pointer */ { static char *envopen[] = { - "-cachesize", +#if CONFIG_TEST + "-auto_commit", "-cdb", "-cdb_alldb", "-client_timeout", - "-create", - "-data_dir", - "-errfile", - "-errpfx", - "-home", "-lock", "-lock_conflict", "-lock_detect", @@ -324,28 +355,46 @@ bdb_EnvOpen(interp, objc, objv, ip, env) "-lock_max_locks", "-lock_max_lockers", "-lock_max_objects", + "-lock_timeout", "-log", "-log_buffer", - "-log_dir", "-log_max", + "-log_regionmax", "-mmapsize", - "-mode", "-nommap", - "-private", - "-recover", - "-recover_fatal", + "-overwrite", "-region_init", + "-rep_client", + "-rep_logsonly", + "-rep_master", + "-rep_transport", "-server", "-server_timeout", + "-txn_timeout", + "-txn_timestamp", + "-verbose", + "-wrnosync", +#endif + "-cachesize", + "-create", + "-data_dir", + "-encryptaes", + "-encryptany", + "-errfile", + "-errpfx", + "-home", + "-log_dir", + "-mode", + "-private", + "-recover", + "-recover_fatal", "-shm_key", "-system_mem", "-tmp_dir", "-txn", "-txn_max", - "-txn_timestamp", "-use_environ", "-use_environ_root", - "-verbose", NULL }; /* @@ -354,15 +403,11 @@ bdb_EnvOpen(interp, objc, objv, ip, env) * which is close to but not quite alphabetical. */ enum envopen { - ENV_CACHESIZE, +#if CONFIG_TEST + ENV_AUTO_COMMIT, ENV_CDB, ENV_CDB_ALLDB, ENV_CLIENT_TO, - ENV_CREATE, - ENV_DATA_DIR, - ENV_ERRFILE, - ENV_ERRPFX, - ENV_HOME, ENV_LOCK, ENV_CONFLICT, ENV_DETECT, @@ -370,52 +415,82 @@ bdb_EnvOpen(interp, objc, objv, ip, env) ENV_LOCK_MAX_LOCKS, ENV_LOCK_MAX_LOCKERS, ENV_LOCK_MAX_OBJECTS, + ENV_LOCK_TIMEOUT, ENV_LOG, ENV_LOG_BUFFER, - ENV_LOG_DIR, ENV_LOG_MAX, + ENV_LOG_REGIONMAX, ENV_MMAPSIZE, - ENV_MODE, ENV_NOMMAP, - ENV_PRIVATE, - ENV_RECOVER, - ENV_RECOVER_FATAL, + ENV_OVERWRITE, ENV_REGION_INIT, + ENV_REP_CLIENT, + ENV_REP_LOGSONLY, + ENV_REP_MASTER, + ENV_REP_TRANSPORT, ENV_SERVER, ENV_SERVER_TO, + ENV_TXN_TIMEOUT, + ENV_TXN_TIME, + ENV_VERBOSE, + ENV_WRNOSYNC, +#endif + ENV_CACHESIZE, + 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_SHM_KEY, ENV_SYSTEM_MEM, ENV_TMP_DIR, ENV_TXN, ENV_TXN_MAX, - ENV_TXN_TIME, ENV_USE_ENVIRON, - ENV_USE_ENVIRON_ROOT, - ENV_VERBOSE + ENV_USE_ENVIRON_ROOT }; Tcl_Obj **myobjv, **myobjv1; - time_t time; - u_int32_t detect, gbytes, bytes, ncaches, open_flags, set_flag, size; + time_t timestamp; + u_int32_t detect, gbytes, bytes, ncaches, logbufset, logmaxset; + u_int32_t open_flags, rep_flags, set_flags, size, uintarg; u_int8_t *conflicts; - int i, intarg, itmp, j, logbufset, logmaxset; - int mode, myobjc, nmodes, optindex, result, ret, temp; + int i, intarg, j, mode, myobjc, nmodes, optindex; + int result, ret, temp; long client_to, server_to, shm; - char *arg, *home, *server; + char *arg, *home, *passwd, *server; result = TCL_OK; mode = 0; - set_flag = 0; + rep_flags = set_flags = 0; home = NULL; + /* * XXX * If/when our Tcl interface becomes thread-safe, we should enable - * DB_THREAD here. Note that DB_THREAD currently does not work - * with log_get -next, -prev; if we wish to enable DB_THREAD, - * those must either be made thread-safe first or we must come up with - * a workaround. (We used to specify DB_THREAD if and only if - * logging was not configured.) + * DB_THREAD here in all cases. For now, turn it on only when testing + * so that we exercise MUTEX_THREAD_LOCK cases. + * + * Historically, a key stumbling block was the log_get interface, + * which could only do relative operations in a non-threaded + * environment. This is no longer an issue, thanks to log cursors, + * but we need to look at making sure DBTCL_INFO structs + * are safe to share across threads (they're not mutex-protected) + * before we declare the Tcl interface thread-safe. Meanwhile, + * there's no strong reason to enable DB_THREAD. */ - open_flags = DB_JOINENV; + open_flags = DB_JOINENV | +#ifdef TEST_THREAD + DB_THREAD; +#else + 0; +#endif logmaxset = logbufset = 0; if (objc <= 2) { @@ -436,6 +511,7 @@ bdb_EnvOpen(interp, objc, objv, ip, env) continue; } switch ((enum envopen)optindex) { +#if CONFIG_TEST case ENV_SERVER: if (i >= objc) { Tcl_WrongNumArgs(interp, 2, objv, @@ -465,6 +541,7 @@ bdb_EnvOpen(interp, objc, objv, ip, env) result = Tcl_GetLongFromObj(interp, objv[i++], &client_to); break; +#endif default: break; } @@ -472,10 +549,11 @@ bdb_EnvOpen(interp, objc, objv, ip, env) if (server != NULL) { ret = db_env_create(env, DB_CLIENT); if (ret) - return (_ReturnSetup(interp, ret, "db_env_create")); + return (_ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "db_env_create")); (*env)->set_errpfx((*env), ip->i_name); (*env)->set_errcall((*env), _ErrorFunc); - if ((ret = (*env)->set_server((*env), server, + if ((ret = (*env)->set_rpc_server((*env), NULL, server, client_to, server_to, 0)) != 0) { result = TCL_ERROR; goto error; @@ -487,17 +565,30 @@ bdb_EnvOpen(interp, objc, objv, ip, env) */ ret = db_env_create(env, 0); if (ret) - return (_ReturnSetup(interp, ret, "db_env_create")); + return (_ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "db_env_create")); (*env)->set_errpfx((*env), ip->i_name); (*env)->set_errcall((*env), _ErrorFunc); } + /* Hang our info pointer on the env handle, so we can do callbacks. */ + (*env)->app_private = ip; + + /* + * Use a Tcl-local alloc and free function so that we're sure to + * test whether we use umalloc/ufree in the right places. + */ +#ifdef TEST_ALLOC + (*env)->set_alloc(*env, tcl_db_malloc, tcl_db_realloc, tcl_db_free); +#endif + /* * Get the command name index from the object based on the bdbcmds * defined above. */ 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]); @@ -505,6 +596,7 @@ bdb_EnvOpen(interp, objc, objv, ip, env) } i++; switch ((enum envopen)optindex) { +#if CONFIG_TEST case ENV_SERVER: case ENV_SERVER_TO: case ENV_CLIENT_TO: @@ -513,208 +605,20 @@ bdb_EnvOpen(interp, objc, objv, ip, env) */ i++; 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); FLD_CLR(open_flags, DB_JOINENV); break; case ENV_CDB_ALLDB: - FLD_SET(set_flag, DB_CDB_ALLDB); + FLD_SET(set_flags, DB_CDB_ALLDB); break; case ENV_LOCK: FLD_SET(open_flags, DB_INIT_LOCK | DB_INIT_MPOOL); FLD_CLR(open_flags, DB_JOINENV); break; - case ENV_LOG: - FLD_SET(open_flags, DB_INIT_LOG | DB_INIT_MPOOL); - FLD_CLR(open_flags, DB_JOINENV); - break; - case ENV_TXN: - FLD_SET(open_flags, DB_INIT_LOCK | - DB_INIT_LOG | DB_INIT_MPOOL | DB_INIT_TXN); - FLD_CLR(open_flags, DB_JOINENV); - /* Make sure we have an arg to check against! */ - if (i < objc) { - arg = Tcl_GetStringFromObj(objv[i], NULL); - if (strcmp(arg, "nosync") == 0) { - FLD_SET(set_flag, DB_TXN_NOSYNC); - i++; - } - } - break; - case ENV_CREATE: - FLD_SET(open_flags, DB_CREATE | DB_INIT_MPOOL); - FLD_CLR(open_flags, DB_JOINENV); - break; - case ENV_HOME: - /* Make sure we have an arg to check against! */ - 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; - } - /* - * Don't need to check result here because - * if TCL_ERROR, the error message is already - * set up, and we'll bail out below. If ok, - * the mode is set and we go on. - */ - result = Tcl_GetIntFromObj(interp, objv[i++], &mode); - break; - case ENV_NOMMAP: - FLD_SET(set_flag, DB_NOMMAP); - break; - case ENV_PRIVATE: - FLD_SET(open_flags, DB_PRIVATE | DB_INIT_MPOOL); - FLD_CLR(open_flags, DB_JOINENV); - 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_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_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_REGION_INIT: - _debug_check(); - ret = db_env_set_region_init(1); - result = _ReturnSetup(interp, ret, "region_init"); - break; - case ENV_CACHESIZE: - result = Tcl_ListObjGetElements(interp, objv[i], - &myobjc, &myobjv); - if (result == TCL_OK) - i++; - else - break; - j = 0; - if (myobjc != 3) { - Tcl_WrongNumArgs(interp, 2, objv, - "?-cachesize {gbytes bytes ncaches}?"); - result = TCL_ERROR; - break; - } - result = Tcl_GetIntFromObj(interp, myobjv[0], &itmp); - gbytes = itmp; - if (result != TCL_OK) - break; - result = Tcl_GetIntFromObj(interp, myobjv[1], &itmp); - bytes = itmp; - if (result != TCL_OK) - break; - result = Tcl_GetIntFromObj(interp, myobjv[2], &itmp); - ncaches = itmp; - if (result != TCL_OK) - break; - _debug_check(); - ret = (*env)->set_cachesize(*env, gbytes, bytes, - ncaches); - result = _ReturnSetup(interp, ret, "set_cachesize"); - break; - case ENV_MMAPSIZE: - if (i >= objc) { - Tcl_WrongNumArgs(interp, 2, objv, - "?-mmapsize 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, "mmapsize"); - } - 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, "shm_key"); - } - break; - case ENV_LOG_MAX: - if (i >= objc) { - Tcl_WrongNumArgs(interp, 2, objv, - "?-log_max max?"); - result = TCL_ERROR; - break; - } - result = Tcl_GetIntFromObj(interp, objv[i++], &intarg); - if (result == TCL_OK && logbufset) { - _debug_check(); - ret = (*env)->set_lg_max(*env, - (u_int32_t)intarg); - result = _ReturnSetup(interp, ret, "log_max"); - logbufset = 0; - } else - logmaxset = intarg; - break; - case ENV_LOG_BUFFER: - if (i >= objc) { - Tcl_WrongNumArgs(interp, 2, objv, - "?-log_buffer size?"); - result = TCL_ERROR; - break; - } - result = Tcl_GetIntFromObj(interp, objv[i++], &intarg); - if (result == TCL_OK) { - _debug_check(); - ret = (*env)->set_lg_bsize(*env, - (u_int32_t)intarg); - result = _ReturnSetup(interp, ret, "log_bsize"); - logbufset = 1; - if (logmaxset) { - _debug_check(); - ret = (*env)->set_lg_max(*env, - (u_int32_t)logmaxset); - result = _ReturnSetup(interp, ret, - "log_max"); - logmaxset = 0; - logbufset = 0; - } - } - break; case ENV_CONFLICT: /* * Get conflict list. List is: @@ -747,7 +651,7 @@ bdb_EnvOpen(interp, objc, objv, ip, env) break; } size = sizeof(u_int8_t) * nmodes*nmodes; - ret = __os_malloc(*env, size, NULL, &conflicts); + ret = __os_malloc(*env, size, &conflicts); if (ret != 0) { result = TCL_ERROR; break; @@ -757,15 +661,16 @@ bdb_EnvOpen(interp, objc, objv, ip, env) &temp); conflicts[j] = temp; if (result != TCL_OK) { - __os_free(conflicts, size); + __os_free(NULL, conflicts); break; } } _debug_check(); ret = (*env)->set_lk_conflicts(*env, (u_int8_t *)conflicts, nmodes); - __os_free(conflicts, size); - result = _ReturnSetup(interp, ret, "set_lk_conflicts"); + __os_free(NULL, conflicts); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "set_lk_conflicts"); break; case ENV_DETECT: if (i >= objc) { @@ -777,6 +682,14 @@ bdb_EnvOpen(interp, objc, objv, ip, env) 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, "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) @@ -791,7 +704,8 @@ bdb_EnvOpen(interp, objc, objv, ip, env) } _debug_check(); ret = (*env)->set_lk_detect(*env, detect); - result = _ReturnSetup(interp, ret, "lock_detect"); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "lock_detect"); break; case ENV_LOCK_MAX: case ENV_LOCK_MAX_LOCKS: @@ -803,61 +717,373 @@ bdb_EnvOpen(interp, objc, objv, ip, env) result = TCL_ERROR; break; } - result = Tcl_GetIntFromObj(interp, objv[i++], &intarg); + result = _GetUInt32(interp, objv[i++], &uintarg); if (result == TCL_OK) { _debug_check(); switch ((enum envopen)optindex) { case ENV_LOCK_MAX: ret = (*env)->set_lk_max(*env, - (u_int32_t)intarg); + uintarg); break; case ENV_LOCK_MAX_LOCKS: ret = (*env)->set_lk_max_locks(*env, - (u_int32_t)intarg); + uintarg); break; case ENV_LOCK_MAX_LOCKERS: ret = (*env)->set_lk_max_lockers(*env, - (u_int32_t)intarg); + uintarg); break; case ENV_LOCK_MAX_OBJECTS: ret = (*env)->set_lk_max_objects(*env, - (u_int32_t)intarg); + uintarg); break; default: break; } - result = _ReturnSetup(interp, ret, "lock_max"); + result = _ReturnSetup(interp, ret, + DB_RETOK_STD(ret), "lock_max"); } break; - case ENV_TXN_MAX: + case ENV_TXN_TIME: + case ENV_TXN_TIMEOUT: + case ENV_LOCK_TIMEOUT: if (i >= objc) { Tcl_WrongNumArgs(interp, 2, objv, - "?-txn_max max?"); + "?-txn_timestamp time?"); + result = TCL_ERROR; + break; + } + result = Tcl_GetLongFromObj(interp, objv[i++], + (long *)×tamp); + if (result == TCL_OK) { + _debug_check(); + if (optindex == ENV_TXN_TIME) + ret = (*env)-> + set_tx_timestamp(*env, ×tamp); + else + ret = (*env)->set_timeout(*env, + (db_timeout_t)timestamp, + 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); + FLD_CLR(open_flags, DB_JOINENV); + 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_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_MMAPSIZE: + if (i >= objc) { + Tcl_WrongNumArgs(interp, 2, objv, + "?-mmapsize size?"); result = TCL_ERROR; break; } result = Tcl_GetIntFromObj(interp, objv[i++], &intarg); if (result == TCL_OK) { _debug_check(); - ret = (*env)->set_tx_max(*env, - (u_int32_t)intarg); - result = _ReturnSetup(interp, ret, "txn_max"); + ret = (*env)->set_mp_mmapsize(*env, + (size_t)intarg); + result = _ReturnSetup(interp, ret, + DB_RETOK_STD(ret), "mmapsize"); } break; - case ENV_TXN_TIME: + case ENV_NOMMAP: + FLD_SET(set_flags, DB_NOMMAP); + 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_REP_CLIENT: + rep_flags = DB_REP_CLIENT; + break; + case ENV_REP_LOGSONLY: + rep_flags = DB_REP_LOGSONLY; + break; + case ENV_REP_MASTER: + rep_flags = DB_REP_MASTER; + break; + case ENV_REP_TRANSPORT: if (i >= objc) { Tcl_WrongNumArgs(interp, 2, objv, - "?-txn_timestamp time?"); + "-rep_transport {envid sendproc}"); result = TCL_ERROR; break; } - result = Tcl_GetLongFromObj(interp, objv[i++], - (long *)&time); + + /* + * Store the objects containing the machine ID + * and the procedure name. We don't need to crack + * the send procedure out now, but we do convert the + * machine ID to an int, since set_rep_transport needs + * it. Even so, it'll be easier later to deal with + * the Tcl_Obj *, so we save that, not the int. + * + * Note that we Tcl_IncrRefCount both objects + * independently; Tcl is free to discard the list + * that they're bundled into. + */ + result = Tcl_ListObjGetElements(interp, objv[i++], + &myobjc, &myobjv); + if (myobjc != 2) { + Tcl_SetResult(interp, + "List must be {envid sendproc}", + TCL_STATIC); + result = TCL_ERROR; + break; + } + + /* + * Check that the machine ID is an int. Note that + * we do want to use GetIntFromObj; the machine + * ID is explicitly an int, not a u_int32_t. + */ + ip->i_rep_eid = myobjv[0]; + Tcl_IncrRefCount(ip->i_rep_eid); + result = Tcl_GetIntFromObj(interp, + ip->i_rep_eid, &intarg); + if (result != TCL_OK) + break; + + ip->i_rep_send = myobjv[1]; + Tcl_IncrRefCount(ip->i_rep_send); + _debug_check(); + ret = (*env)->set_rep_transport(*env, + intarg, tcl_rep_send); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "set_rep_transport"); + 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); + FLD_CLR(open_flags, DB_JOINENV); + /* Make sure we have an arg to check against! */ + if (i < objc) { + arg = Tcl_GetStringFromObj(objv[i], NULL); + if (strcmp(arg, "nosync") == 0) { + FLD_SET(set_flags, DB_TXN_NOSYNC); + i++; + } + } + break; + case ENV_CREATE: + FLD_SET(open_flags, DB_CREATE | DB_INIT_MPOOL); + FLD_CLR(open_flags, DB_JOINENV); + break; + case ENV_ENCRYPT_AES: + /* Make sure we have an arg to check against! */ + 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: + /* Make sure we have an arg to check against! */ + 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: + /* Make sure we have an arg to check against! */ + 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; + } + /* + * Don't need to check result here because + * if TCL_ERROR, the error message is already + * set up, and we'll bail out below. If ok, + * the mode is set and we go on. + */ + result = Tcl_GetIntFromObj(interp, objv[i++], &mode); + break; + case ENV_PRIVATE: + FLD_SET(open_flags, DB_PRIVATE | DB_INIT_MPOOL); + FLD_CLR(open_flags, DB_JOINENV); + 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_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 = _GetUInt32(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_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_tx_timestamp(*env, &time); + 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, - "txn_timestamp"); + DB_RETOK_STD(ret), "txn_max"); } break; case ENV_ERRFILE: @@ -891,11 +1117,11 @@ bdb_EnvOpen(interp, objc, objv, ip, env) * If the user already set one, free it. */ if (ip->i_errpfx != NULL) - __os_freestr(ip->i_errpfx); + __os_free(NULL, ip->i_errpfx); if ((ret = __os_strdup(*env, arg, &ip->i_errpfx)) != 0) { result = _ReturnSetup(interp, ret, - "__os_strdup"); + DB_RETOK_STD(ret), "__os_strdup"); break; } if (ip->i_errpfx != NULL) { @@ -913,7 +1139,8 @@ bdb_EnvOpen(interp, objc, objv, ip, env) arg = Tcl_GetStringFromObj(objv[i++], NULL); _debug_check(); ret = (*env)->set_data_dir(*env, arg); - result = _ReturnSetup(interp, ret, "set_data_dir"); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "set_data_dir"); break; case ENV_LOG_DIR: if (i >= objc) { @@ -925,7 +1152,8 @@ bdb_EnvOpen(interp, objc, objv, ip, env) arg = Tcl_GetStringFromObj(objv[i++], NULL); _debug_check(); ret = (*env)->set_lg_dir(*env, arg); - result = _ReturnSetup(interp, ret, "set_lg_dir"); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "set_lg_dir"); break; case ENV_TMP_DIR: if (i >= objc) { @@ -937,7 +1165,8 @@ bdb_EnvOpen(interp, objc, objv, ip, env) arg = Tcl_GetStringFromObj(objv[i++], NULL); _debug_check(); ret = (*env)->set_tmp_dir(*env, arg); - result = _ReturnSetup(interp, ret, "set_tmp_dir"); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "set_tmp_dir"); break; } /* @@ -959,15 +1188,17 @@ bdb_EnvOpen(interp, objc, objv, ip, env) if (logmaxset) { _debug_check(); ret = (*env)->set_lg_max(*env, (u_int32_t)logmaxset); - result = _ReturnSetup(interp, ret, "log_max"); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "log_max"); } if (result != TCL_OK) goto error; - if (set_flag) { - ret = (*env)->set_flags(*env, set_flag, 1); - result = _ReturnSetup(interp, ret, "set_flags"); + 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; /* @@ -985,10 +1216,16 @@ bdb_EnvOpen(interp, objc, objv, ip, env) */ _debug_check(); ret = (*env)->open(*env, home, open_flags, mode); - result = _ReturnSetup(interp, ret, "env open"); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "env open"); -error: - if (result == TCL_ERROR) { + 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) { fclose(ip->i_err); ip->i_err = NULL; @@ -1027,12 +1264,28 @@ bdb_DbOpen(interp, objc, objv, ip, dbp) TCL_DB_ENV0 }; static char *bdbopen[] = { +#if CONFIG_TEST + "-btcompare", + "-dirty", + "-dupcompare", + "-hashproc", + "-lorder", + "-minkey", + "-nommap", + "-revsplitoff", + "-test", +#endif + "-auto_commit", "-btree", "-cachesize", + "-chksum", "-create", "-delim", "-dup", "-dupsort", + "-encrypt", + "-encryptaes", + "-encryptany", "-env", "-errfile", "-errpfx", @@ -1041,11 +1294,8 @@ bdb_DbOpen(interp, objc, objv, ip, dbp) "-ffactor", "-hash", "-len", - "-lorder", - "-minkey", "-mode", "-nelem", - "-nommap", "-pad", "-pagesize", "-queue", @@ -1053,22 +1303,37 @@ bdb_DbOpen(interp, objc, objv, ip, dbp) "-recno", "-recnum", "-renumber", - "-revsplitoff", "-snapshot", "-source", "-truncate", - "-test", + "-txn", "-unknown", "--", NULL }; enum bdbopen { +#if CONFIG_TEST + TCL_DB_BTCOMPARE, + TCL_DB_DIRTY, + TCL_DB_DUPCOMPARE, + TCL_DB_HASHPROC, + TCL_DB_LORDER, + TCL_DB_MINKEY, + TCL_DB_NOMMAP, + TCL_DB_REVSPLIT, + TCL_DB_TEST, +#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, @@ -1077,11 +1342,8 @@ bdb_DbOpen(interp, objc, objv, ip, dbp) TCL_DB_FFACTOR, TCL_DB_HASH, TCL_DB_LEN, - TCL_DB_LORDER, - TCL_DB_MINKEY, TCL_DB_MODE, TCL_DB_NELEM, - TCL_DB_NOMMAP, TCL_DB_PAD, TCL_DB_PAGESIZE, TCL_DB_QUEUE, @@ -1089,28 +1351,27 @@ bdb_DbOpen(interp, objc, objv, ip, dbp) TCL_DB_RECNO, TCL_DB_RECNUM, TCL_DB_RENUMBER, - TCL_DB_REVSPLIT, TCL_DB_SNAPSHOT, TCL_DB_SOURCE, TCL_DB_TRUNCATE, - TCL_DB_TEST, + 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, ncaches, open_flags; - int endarg, i, intarg, itmp, j, mode, myobjc; - int optindex, result, ret, set_err, set_flag, set_pfx, subdblen; + u_int32_t gbytes, bytes, ncaches, open_flags, uintarg; + int endarg, i, intarg, mode, myobjc; + int optindex, result, ret, set_err, set_flags, set_pfx, subdblen; u_char *subdbtmp; - char *arg, *db, *subdb; - extern u_int32_t __ham_test __P((DB *, const void *, u_int32_t)); + char *arg, *db, *passwd, *subdb, msg[MSG_SIZE]; type = DB_UNKNOWN; - endarg = mode = set_err = set_flag = set_pfx = 0; + endarg = mode = set_err = set_flags = set_pfx = 0; result = TCL_OK; subdbtmp = NULL; db = subdb = NULL; @@ -1118,10 +1379,18 @@ bdb_DbOpen(interp, objc, objv, ip, dbp) /* * XXX * If/when our Tcl interface becomes thread-safe, we should enable - * DB_THREAD here. See comment in bdb_EnvOpen(). + * DB_THREAD here in all cases. See comment in bdb_EnvOpen(). + * For now, just turn it on when testing so that we exercise + * MUTEX_THREAD_LOCK cases. */ - open_flags = 0; + open_flags = +#ifdef TEST_THREAD + DB_THREAD; +#else + 0; +#endif envp = NULL; + txn = NULL; if (objc < 2) { Tcl_WrongNumArgs(interp, 2, objv, "?args?"); @@ -1162,7 +1431,11 @@ bdb_DbOpen(interp, objc, objv, ip, dbp) */ ret = db_create(dbp, envp, 0); if (ret) - return (_ReturnSetup(interp, ret, "db_create")); + return (_ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "db_create")); + + /* Hang our info pointer on the DB handle, so we can do callbacks. */ + (*dbp)->api_internal = ip; /* * XXX Remove restriction when err stuff is not tied to env. @@ -1193,6 +1466,7 @@ bdb_DbOpen(interp, objc, objv, ip, dbp) */ 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); @@ -1205,12 +1479,134 @@ bdb_DbOpen(interp, objc, objv, ip, dbp) } i++; switch ((enum bdbopen)optindex) { +#if CONFIG_TEST + case TCL_DB_BTCOMPARE: + if (i >= objc) { + Tcl_WrongNumArgs(interp, 2, objv, + "-btcompare compareproc"); + result = TCL_ERROR; + break; + } + + /* + * Store the object containing the procedure name. + * We don't need to crack it out now--we'll want + * to bundle it up to pass into Tcl_EvalObjv anyway. + * Tcl's object refcounting will--I hope--take care + * of the memory management here. + */ + ip->i_btcompare = objv[i++]; + Tcl_IncrRefCount(ip->i_btcompare); + _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_DIRTY: + open_flags |= DB_DIRTY_READ; + break; + case TCL_DB_DUPCOMPARE: + if (i >= objc) { + Tcl_WrongNumArgs(interp, 2, objv, + "-dupcompare compareproc"); + result = TCL_ERROR; + break; + } + + /* + * Store the object containing the procedure name. + * See TCL_DB_BTCOMPARE. + */ + 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_HASHPROC: + if (i >= objc) { + Tcl_WrongNumArgs(interp, 2, objv, + "-hashproc hashproc"); + result = TCL_ERROR; + break; + } + + /* + * Store the object containing the procedure name. + * See TCL_DB_BTCOMPARE. + */ + 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 = _GetUInt32(interp, objv[i++], &uintarg); + if (result == TCL_OK) { + _debug_check(); + ret = (*dbp)->set_lorder(*dbp, uintarg); + 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_REVSPLIT: + set_flags |= DB_REVSPLITOFF; + break; + case TCL_DB_TEST: + (*dbp)->set_h_hash(*dbp, __ham_test); + break; +#endif + case TCL_DB_AUTO_COMMIT: + open_flags |= DB_AUTO_COMMIT; + break; case TCL_DB_ENV: /* * Already parsed this, skip it and the env pointer. */ 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, + "Put: 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, @@ -1267,9 +1663,6 @@ bdb_DbOpen(interp, objc, objv, ip, dbp) case TCL_DB_TRUNCATE: open_flags |= DB_TRUNCATE; break; - case TCL_DB_TEST: - (*dbp)->set_h_hash(*dbp, __ham_test); - break; case TCL_DB_MODE: if (i >= objc) { Tcl_WrongNumArgs(interp, 2, objv, @@ -1285,73 +1678,83 @@ bdb_DbOpen(interp, objc, objv, ip, dbp) */ result = Tcl_GetIntFromObj(interp, objv[i++], &mode); break; - case TCL_DB_NOMMAP: - open_flags |= DB_NOMMAP; - break; case TCL_DB_DUP: - set_flag |= DB_DUP; + set_flags |= DB_DUP; break; case TCL_DB_DUPSORT: - set_flag |= DB_DUPSORT; + set_flags |= DB_DUPSORT; break; case TCL_DB_RECNUM: - set_flag |= DB_RECNUM; + set_flags |= DB_RECNUM; break; case TCL_DB_RENUMBER: - set_flag |= DB_RENUMBER; - break; - case TCL_DB_REVSPLIT: - set_flag |= DB_REVSPLITOFF; + set_flags |= DB_RENUMBER; break; case TCL_DB_SNAPSHOT: - set_flag |= DB_SNAPSHOT; + set_flags |= DB_SNAPSHOT; break; - case TCL_DB_FFACTOR: + case TCL_DB_CHKSUM: + set_flags |= DB_CHKSUM_SHA1; + break; + case TCL_DB_ENCRYPT: + set_flags |= DB_ENCRYPT; + break; + case TCL_DB_ENCRYPT_AES: + /* Make sure we have an arg to check against! */ if (i >= objc) { Tcl_WrongNumArgs(interp, 2, objv, - "-ffactor density"); + "?-encryptaes passwd?"); result = TCL_ERROR; break; } - result = Tcl_GetIntFromObj(interp, objv[i++], &intarg); - if (result == TCL_OK) { - _debug_check(); - ret = (*dbp)->set_h_ffactor(*dbp, - (u_int32_t)intarg); - result = _ReturnSetup(interp, ret, - "set_h_ffactor"); + 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: + /* Make sure we have an arg to check against! */ + 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_NELEM: + case TCL_DB_FFACTOR: if (i >= objc) { Tcl_WrongNumArgs(interp, 2, objv, - "-nelem nelem"); + "-ffactor density"); result = TCL_ERROR; break; } - result = Tcl_GetIntFromObj(interp, objv[i++], &intarg); + result = _GetUInt32(interp, objv[i++], &uintarg); if (result == TCL_OK) { _debug_check(); - ret = (*dbp)->set_h_nelem(*dbp, - (u_int32_t)intarg); + ret = (*dbp)->set_h_ffactor(*dbp, uintarg); result = _ReturnSetup(interp, ret, - "set_h_nelem"); + DB_RETOK_STD(ret), "set_h_ffactor"); } break; - case TCL_DB_LORDER: + case TCL_DB_NELEM: if (i >= objc) { Tcl_WrongNumArgs(interp, 2, objv, - "-lorder 1234|4321"); + "-nelem nelem"); result = TCL_ERROR; break; } - result = Tcl_GetIntFromObj(interp, objv[i++], &intarg); + result = _GetUInt32(interp, objv[i++], &uintarg); if (result == TCL_OK) { _debug_check(); - ret = (*dbp)->set_lorder(*dbp, - (u_int32_t)intarg); + ret = (*dbp)->set_h_nelem(*dbp, uintarg); result = _ReturnSetup(interp, ret, - "set_lorder"); + DB_RETOK_STD(ret), "set_h_nelem"); } break; case TCL_DB_DELIM: @@ -1366,7 +1769,7 @@ bdb_DbOpen(interp, objc, objv, ip, dbp) _debug_check(); ret = (*dbp)->set_re_delim(*dbp, intarg); result = _ReturnSetup(interp, ret, - "set_re_delim"); + DB_RETOK_STD(ret), "set_re_delim"); } break; case TCL_DB_LEN: @@ -1376,13 +1779,12 @@ bdb_DbOpen(interp, objc, objv, ip, dbp) result = TCL_ERROR; break; } - result = Tcl_GetIntFromObj(interp, objv[i++], &intarg); + result = _GetUInt32(interp, objv[i++], &uintarg); if (result == TCL_OK) { _debug_check(); - ret = (*dbp)->set_re_len(*dbp, - (u_int32_t)intarg); + ret = (*dbp)->set_re_len(*dbp, uintarg); result = _ReturnSetup(interp, ret, - "set_re_len"); + DB_RETOK_STD(ret), "set_re_len"); } break; case TCL_DB_PAD: @@ -1397,7 +1799,7 @@ bdb_DbOpen(interp, objc, objv, ip, dbp) _debug_check(); ret = (*dbp)->set_re_pad(*dbp, intarg); result = _ReturnSetup(interp, ret, - "set_re_pad"); + DB_RETOK_STD(ret), "set_re_pad"); } break; case TCL_DB_SOURCE: @@ -1410,7 +1812,8 @@ bdb_DbOpen(interp, objc, objv, ip, dbp) arg = Tcl_GetStringFromObj(objv[i++], NULL); _debug_check(); ret = (*dbp)->set_re_source(*dbp, arg); - result = _ReturnSetup(interp, ret, "set_re_source"); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "set_re_source"); break; case TCL_DB_EXTENT: if (i >= objc) { @@ -1419,28 +1822,12 @@ bdb_DbOpen(interp, objc, objv, ip, dbp) result = TCL_ERROR; break; } - result = Tcl_GetIntFromObj(interp, objv[i++], &intarg); - if (result == TCL_OK) { - _debug_check(); - ret = (*dbp)->set_q_extentsize(*dbp, - (u_int32_t)intarg); - result = _ReturnSetup(interp, ret, - "set_q_extentsize"); - } - break; - case TCL_DB_MINKEY: - if (i >= objc) { - Tcl_WrongNumArgs(interp, 2, objv, - "-minkey minkey"); - result = TCL_ERROR; - break; - } - result = Tcl_GetIntFromObj(interp, objv[i++], &intarg); + result = _GetUInt32(interp, objv[i++], &uintarg); if (result == TCL_OK) { _debug_check(); - ret = (*dbp)->set_bt_minkey(*dbp, intarg); + ret = (*dbp)->set_q_extentsize(*dbp, uintarg); result = _ReturnSetup(interp, ret, - "set_bt_minkey"); + DB_RETOK_STD(ret), "set_q_extentsize"); } break; case TCL_DB_CACHESIZE: @@ -1448,30 +1835,26 @@ bdb_DbOpen(interp, objc, objv, ip, dbp) &myobjc, &myobjv); if (result != TCL_OK) break; - j = 0; if (myobjc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "?-cachesize {gbytes bytes ncaches}?"); result = TCL_ERROR; break; } - result = Tcl_GetIntFromObj(interp, myobjv[0], &itmp); - gbytes = itmp; + result = _GetUInt32(interp, myobjv[0], &gbytes); if (result != TCL_OK) break; - result = Tcl_GetIntFromObj(interp, myobjv[1], &itmp); - bytes = itmp; + result = _GetUInt32(interp, myobjv[1], &bytes); if (result != TCL_OK) break; - result = Tcl_GetIntFromObj(interp, myobjv[2], &itmp); - ncaches = itmp; + result = _GetUInt32(interp, myobjv[2], &ncaches); if (result != TCL_OK) break; _debug_check(); ret = (*dbp)->set_cachesize(*dbp, gbytes, bytes, ncaches); result = _ReturnSetup(interp, ret, - "set_cachesize"); + DB_RETOK_STD(ret), "set_cachesize"); break; case TCL_DB_PAGESIZE: if (i >= objc) { @@ -1486,7 +1869,7 @@ bdb_DbOpen(interp, objc, objv, ip, dbp) ret = (*dbp)->set_pagesize(*dbp, (size_t)intarg); result = _ReturnSetup(interp, ret, - "set pagesize"); + DB_RETOK_STD(ret), "set pagesize"); } break; case TCL_DB_ERRFILE: @@ -1521,11 +1904,11 @@ bdb_DbOpen(interp, objc, objv, ip, dbp) * If the user already set one, free it. */ if (errip->i_errpfx != NULL) - __os_freestr(errip->i_errpfx); + __os_free(NULL, errip->i_errpfx); if ((ret = __os_strdup((*dbp)->dbenv, arg, &errip->i_errpfx)) != 0) { result = _ReturnSetup(interp, ret, - "__os_strdup"); + DB_RETOK_STD(ret), "__os_strdup"); break; } if (errip->i_errpfx != NULL) { @@ -1567,7 +1950,7 @@ bdb_DbOpen(interp, objc, objv, ip, dbp) subdbtmp = Tcl_GetByteArrayFromObj(objv[i++], &subdblen); if ((ret = __os_malloc(envp, - subdblen + 1, NULL, &subdb)) != 0) { + subdblen + 1, &subdb)) != 0) { Tcl_SetResult(interp, db_strerror(ret), TCL_STATIC); return (0); @@ -1576,9 +1959,10 @@ bdb_DbOpen(interp, objc, objv, ip, dbp) subdb[subdblen] = '\0'; } } - if (set_flag) { - ret = (*dbp)->set_flags(*dbp, set_flag); - result = _ReturnSetup(interp, ret, "set_flags"); + 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; /* @@ -1596,13 +1980,14 @@ bdb_DbOpen(interp, objc, objv, ip, dbp) _debug_check(); /* Open the database. */ - ret = (*dbp)->open(*dbp, db, subdb, type, open_flags, mode); - result = _ReturnSetup(interp, ret, "db open"); + 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(subdb, subdblen + 1); + __os_free(envp, subdb); if (result == TCL_ERROR) { + (void)(*dbp)->close(*dbp, 0); /* * If we opened and set up the error file in the environment * on this open, but we failed for some other reason, clean @@ -1619,10 +2004,9 @@ error: errip->i_err = NULL; } if (set_pfx && errip && errip->i_errpfx != NULL) { - __os_freestr(errip->i_errpfx); + __os_free(envp, errip->i_errpfx); errip->i_errpfx = NULL; } - (void)(*dbp)->close(*dbp, 0); *dbp = NULL; } return (result); @@ -1630,7 +2014,7 @@ error: /* * bdb_DbRemove -- - * Implements the DB->remove command. + * Implements the DB_ENV->remove and DB->remove command. */ static int bdb_DbRemove(interp, objc, objv) @@ -1639,24 +2023,41 @@ bdb_DbRemove(interp, objc, objv) Tcl_Obj *CONST objv[]; /* The argument objects */ { static char *bdbrem[] = { - "-env", "--", NULL + "-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_ENV *envp; 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, *subdb; + char *arg, *db, msg[MSG_SIZE], *passwd, *subdb; - envp = NULL; + db = subdb = NULL; dbp = NULL; + endarg = 0; + envp = NULL; + iflags = enc_flag = set_flags = 0; + passwd = NULL; result = TCL_OK; subdbtmp = NULL; - db = subdb = NULL; - endarg = 0; + txn = NULL; if (objc < 2) { Tcl_WrongNumArgs(interp, 2, objv, "?args? filename ?database?"); @@ -1681,6 +2082,36 @@ bdb_DbRemove(interp, objc, objv) } 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: + /* Make sure we have an arg to check against! */ + 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: + /* Make sure we have an arg to check against! */ + 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); @@ -1694,6 +2125,21 @@ bdb_DbRemove(interp, objc, objv) 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, at any time, parsing the args we get an error, @@ -1721,7 +2167,7 @@ bdb_DbRemove(interp, objc, objv) subdbtmp = Tcl_GetByteArrayFromObj(objv[i++], &subdblen); if ((ret = __os_malloc(envp, subdblen + 1, - NULL, &subdb)) != 0) { Tcl_SetResult(interp, + &subdb)) != 0) { Tcl_SetResult(interp, db_strerror(ret), TCL_STATIC); return (0); } @@ -1733,28 +2179,48 @@ bdb_DbRemove(interp, objc, objv) result = TCL_ERROR; goto error; } - ret = db_create(&dbp, envp, 0); - if (ret) { - result = _ReturnSetup(interp, ret, "db_create"); - 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; + } + + 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"); + } } + /* * No matter what, we NULL out dbp after this call. */ - ret = dbp->remove(dbp, db, subdb, 0); - result = _ReturnSetup(interp, ret, "db remove"); + _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(subdb, subdblen + 1); - if (result == TCL_ERROR && dbp) + __os_free(envp, subdb); + if (result == TCL_ERROR && dbp != NULL) (void)dbp->close(dbp, 0); return (result); } /* * bdb_DbRename -- - * Implements the DB->rename command. + * Implements the DBENV->dbrename and DB->rename commands. */ static int bdb_DbRename(interp, objc, objv) @@ -1763,24 +2229,41 @@ bdb_DbRename(interp, objc, objv) Tcl_Obj *CONST objv[]; /* The argument objects */ { static char *bdbmv[] = { - "-env", "--", NULL + "-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_ENV *envp; 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, *newname, *subdb; + char *arg, *db, msg[MSG_SIZE], *newname, *passwd, *subdb; - envp = NULL; + db = newname = subdb = NULL; dbp = NULL; + endarg = 0; + envp = NULL; + iflags = enc_flag = set_flags = 0; + passwd = NULL; result = TCL_OK; subdbtmp = NULL; - db = newname = subdb = NULL; - endarg = 0; + txn = NULL; if (objc < 2) { Tcl_WrongNumArgs(interp, @@ -1806,6 +2289,36 @@ bdb_DbRename(interp, objc, objv) } 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: + /* Make sure we have an arg to check against! */ + 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: + /* Make sure we have an arg to check against! */ + 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); @@ -1819,6 +2332,21 @@ bdb_DbRename(interp, objc, objv) 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, at any time, parsing the args we get an error, @@ -1846,7 +2374,7 @@ bdb_DbRename(interp, objc, objv) subdbtmp = Tcl_GetByteArrayFromObj(objv[i++], &subdblen); if ((ret = __os_malloc(envp, subdblen + 1, - NULL, &subdb)) != 0) { + &subdb)) != 0) { Tcl_SetResult(interp, db_strerror(ret), TCL_STATIC); return (0); @@ -1857,7 +2385,7 @@ bdb_DbRename(interp, objc, objv) subdbtmp = Tcl_GetByteArrayFromObj(objv[i++], &newlen); if ((ret = __os_malloc(envp, newlen + 1, - NULL, &newname)) != 0) { + &newname)) != 0) { Tcl_SetResult(interp, db_strerror(ret), TCL_STATIC); return (0); @@ -1865,31 +2393,50 @@ bdb_DbRename(interp, objc, objv) memcpy(newname, subdbtmp, newlen); newname[newlen] = '\0'; } else { - Tcl_WrongNumArgs(interp, 3, objv, "?args? filename ?database? ?newname?"); + Tcl_WrongNumArgs( + interp, 3, objv, "?args? filename ?database? ?newname?"); result = TCL_ERROR; goto error; } - ret = db_create(&dbp, envp, 0); - if (ret) { - result = _ReturnSetup(interp, ret, "db_create"); - 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; + } + 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"); + } } + /* * No matter what, we NULL out dbp after this call. */ - ret = dbp->rename(dbp, db, subdb, newname, 0); - result = _ReturnSetup(interp, ret, "db rename"); + 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(subdb, subdblen + 1); + __os_free(envp, subdb); if (newname) - __os_free(newname, newlen + 1); - if (result == TCL_ERROR && dbp) + __os_free(envp, newname); + if (result == TCL_ERROR && dbp != NULL) (void)dbp->close(dbp, 0); return (result); } +#if CONFIG_TEST /* * bdb_DbVerify -- * Implements the DB->verify command. @@ -1901,9 +2448,19 @@ bdb_DbVerify(interp, objc, objv) Tcl_Obj *CONST objv[]; /* The argument objects */ { static char *bdbverify[] = { - "-env", "-errfile", "-errpfx", "--", NULL + "-encrypt", + "-encryptaes", + "-encryptany", + "-env", + "-errfile", + "-errpfx", + "--", + NULL }; enum bdbvrfy { + TCL_DBVRFY_ENCRYPT, + TCL_DBVRFY_ENCRYPT_AES, + TCL_DBVRFY_ENCRYPT_ANY, TCL_DBVRFY_ENV, TCL_DBVRFY_ERRFILE, TCL_DBVRFY_ERRPFX, @@ -1912,15 +2469,18 @@ bdb_DbVerify(interp, objc, objv) DB_ENV *envp; DB *dbp; FILE *errf; - int endarg, i, optindex, result, ret, flags; - char *arg, *db, *errpfx; + u_int32_t enc_flag, flags, set_flags; + int endarg, i, optindex, result, ret; + char *arg, *db, *errpfx, *passwd; envp = NULL; dbp = NULL; + passwd = NULL; result = TCL_OK; db = errpfx = NULL; errf = NULL; flags = endarg = 0; + enc_flag = set_flags = 0; if (objc < 2) { Tcl_WrongNumArgs(interp, 2, objv, "?args? filename"); @@ -1945,6 +2505,32 @@ bdb_DbVerify(interp, objc, objv) } i++; switch ((enum bdbvrfy)optindex) { + case TCL_DBVRFY_ENCRYPT: + set_flags |= DB_ENCRYPT; + _debug_check(); + break; + case TCL_DBVRFY_ENCRYPT_AES: + /* Make sure we have an arg to check against! */ + 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: + /* Make sure we have an arg to check against! */ + 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); @@ -1983,10 +2569,10 @@ bdb_DbVerify(interp, objc, objv) * If the user already set one, free it. */ if (errpfx != NULL) - __os_freestr(errpfx); + __os_free(envp, errpfx); if ((ret = __os_strdup(NULL, arg, &errpfx)) != 0) { result = _ReturnSetup(interp, ret, - "__os_strdup"); + DB_RETOK_STD(ret), "__os_strdup"); break; } break; @@ -2017,26 +2603,39 @@ bdb_DbVerify(interp, objc, objv) } ret = db_create(&dbp, envp, 0); if (ret) { - result = _ReturnSetup(interp, ret, "db_create"); + 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, NULL, NULL, flags); - result = _ReturnSetup(interp, ret, "db verify"); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db verify"); error: if (errf != NULL) fclose(errf); if (errpfx != NULL) - __os_freestr(errpfx); + __os_free(envp, errpfx); if (dbp) (void)dbp->close(dbp, 0); return (result); } +#endif /* * bdb_Version -- @@ -2113,6 +2712,7 @@ error: return (result); } +#if CONFIG_TEST /* * bdb_Handles -- * Implements the handles command. @@ -2144,7 +2744,9 @@ bdb_Handles(interp, objc, objv) Tcl_SetObjResult(interp, res); return (TCL_OK); } +#endif +#if CONFIG_TEST /* * bdb_DbUpgrade -- * Implements the DB->upgrade command. @@ -2165,7 +2767,8 @@ bdb_DbUpgrade(interp, objc, objv) }; DB_ENV *envp; DB *dbp; - int endarg, i, optindex, result, ret, flags; + u_int32_t flags; + int endarg, i, optindex, result, ret; char *arg, *db; envp = NULL; @@ -2233,14 +2836,282 @@ bdb_DbUpgrade(interp, objc, objv) } ret = db_create(&dbp, envp, 0); if (ret) { - result = _ReturnSetup(interp, ret, "db_create"); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "db_create"); goto error; } ret = dbp->upgrade(dbp, db, flags); - result = _ReturnSetup(interp, ret, "db upgrade"); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db upgrade"); error: if (dbp) (void)dbp->close(dbp, 0); return (result); } +#endif + +/* + * tcl_bt_compare and tcl_dup_compare -- + * These two are basically identical internally, so may as well + * share code. The only differences are the name used in error + * reporting and the Tcl_Obj representing their respective procs. + */ +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_btcompare, "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")); +} + +/* + * tcl_compare_callback -- + * Tcl callback for set_bt_compare and set_dup_compare. What this + * function does is stuff the data fields of the two DBTs into Tcl ByteArray + * objects, then call the procedure stored in ip->i_btcompare on the two + * objects. Then we return that procedure's result as the comparison. + */ +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; + + /* + * Create two ByteArray objects, with the two data we've been passed. + * This will involve a copy, which is unpleasantly slow, but there's + * little we can do to avoid this (I think). + */ + a = Tcl_NewByteArrayObj(dbta->data, dbta->size); + Tcl_IncrRefCount(a); + b = Tcl_NewByteArrayObj(dbtb->data, dbtb->size); + Tcl_IncrRefCount(b); + + objv[1] = a; + objv[2] = b; + + result = Tcl_EvalObjv(interp, 3, objv, 0); + if (result != TCL_OK) { + /* + * XXX + * If this or the next Tcl call fails, we're doomed. + * There's no way to return an error from comparison functions, + * no way to determine what the correct sort order is, and + * so no way to avoid corrupting the database if we proceed. + * We could play some games stashing return values on the + * DB handle, but it's not worth the trouble--no one with + * any sense is going to be using this other than for testing, + * and failure typically means that the bt_compare proc + * had a syntax error in it or something similarly dumb. + * + * So, drop core. If we're not running with diagnostic + * mode, panic--and always return a negative number. :-) + */ +panic: __db_err(dbp->dbenv, "Tcl %s callback failed", errname); + DB_ASSERT(0); + 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); +} + +/* + * tcl_h_hash -- + * Tcl callback for the hashing function. See tcl_compare_callback-- + * this works much the same way, only we're given a buffer and a length + * instead of two DBTs. + */ +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; + + /* + * Create a ByteArray for the buffer. + */ + objv[1] = Tcl_NewByteArrayObj((void *)buf, len); + Tcl_IncrRefCount(objv[1]); + result = Tcl_EvalObjv(interp, 2, objv, 0); + if (result != TCL_OK) { + /* + * XXX + * We drop core on error. See the comment in + * tcl_compare_callback. + */ +panic: __db_err(dbp->dbenv, "Tcl h_hash callback failed"); + DB_ASSERT(0); + return (__db_panic(dbp->dbenv, DB_RUNRECOVERY)); + } + + result = Tcl_GetIntFromObj(interp, Tcl_GetObjResult(interp), &hval); + if (result != TCL_OK) + goto panic; + + Tcl_DecrRefCount(objv[1]); + return (hval); +} + +/* + * tcl_rep_send -- + * Replication send callback. + */ +static int +tcl_rep_send(dbenv, control, rec, eid, flags) + DB_ENV *dbenv; + const DBT *control, *rec; + int eid; + u_int32_t flags; +{ + DBTCL_INFO *ip; + Tcl_Interp *interp; + Tcl_Obj *control_o, *eid_o, *origobj, *rec_o, *resobj, *objv[5]; + int result, ret; + + COMPQUIET(flags, 0); + + ip = (DBTCL_INFO *)dbenv->app_private; + interp = ip->i_interp; + objv[0] = ip->i_rep_send; + + control_o = Tcl_NewByteArrayObj(control->data, control->size); + Tcl_IncrRefCount(control_o); + + rec_o = Tcl_NewByteArrayObj(rec->data, rec->size); + Tcl_IncrRefCount(rec_o); + + eid_o = Tcl_NewIntObj(eid); + Tcl_IncrRefCount(eid_o); + + objv[1] = control_o; + objv[2] = rec_o; + objv[3] = ip->i_rep_eid; /* From ID */ + objv[4] = eid_o; /* To ID */ + + /* + * We really want to return the original result to the + * user. So, save the result obj here, and then after + * we've taken care of the Tcl_EvalObjv, set the result + * back to this original result. + */ + origobj = Tcl_GetObjResult(interp); + Tcl_IncrRefCount(origobj); + result = Tcl_EvalObjv(interp, 5, objv, 0); + if (result != TCL_OK) { + /* + * XXX + * This probably isn't the right error behavior, but + * this error should only happen if the Tcl callback is + * somehow invalid, which is a fatal scripting bug. + */ +err: __db_err(dbenv, "Tcl rep_send failure"); + 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); + + return (ret); +} + +#ifdef TEST_ALLOC +/* + * tcl_db_malloc, tcl_db_realloc, tcl_db_free -- + * Tcl-local malloc, realloc, and free functions to use for user data + * to exercise umalloc/urealloc/ufree. Allocate the memory as a Tcl object + * so we're sure to exacerbate and catch any shared-library issues. + */ +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, 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, 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 |