diff options
Diffstat (limited to 'bdb/tcl')
| -rw-r--r-- | bdb/tcl/docs/db.html | 403 | ||||
| -rw-r--r-- | bdb/tcl/docs/env.html | 607 | ||||
| -rw-r--r-- | bdb/tcl/docs/historic.html | 3 | ||||
| -rw-r--r-- | bdb/tcl/docs/index.html | 6 | ||||
| -rw-r--r-- | bdb/tcl/docs/library.html | 3 | ||||
| -rw-r--r-- | bdb/tcl/docs/lock.html | 308 | ||||
| -rw-r--r-- | bdb/tcl/docs/log.html | 24 | ||||
| -rw-r--r-- | bdb/tcl/docs/mpool.html | 3 | ||||
| -rw-r--r-- | bdb/tcl/docs/rep.html | 51 | ||||
| -rw-r--r-- | bdb/tcl/docs/test.html | 3 | ||||
| -rw-r--r-- | bdb/tcl/docs/txn.html | 93 | ||||
| -rw-r--r-- | bdb/tcl/tcl_compat.c | 467 | ||||
| -rw-r--r-- | bdb/tcl/tcl_db.c | 1180 | ||||
| -rw-r--r-- | bdb/tcl/tcl_db_pkg.c | 1739 | ||||
| -rw-r--r-- | bdb/tcl/tcl_dbcursor.c | 388 | ||||
| -rw-r--r-- | bdb/tcl/tcl_env.c | 882 | ||||
| -rw-r--r-- | bdb/tcl/tcl_internal.c | 367 | ||||
| -rw-r--r-- | bdb/tcl/tcl_lock.c | 258 | ||||
| -rw-r--r-- | bdb/tcl/tcl_log.c | 441 | ||||
| -rw-r--r-- | bdb/tcl/tcl_mp.c | 194 | ||||
| -rw-r--r-- | bdb/tcl/tcl_rep.c | 405 | ||||
| -rw-r--r-- | bdb/tcl/tcl_txn.c | 338 | ||||
| -rw-r--r-- | bdb/tcl/tcl_util.c | 381 |
23 files changed, 6045 insertions, 2499 deletions
diff --git a/bdb/tcl/docs/db.html b/bdb/tcl/docs/db.html index c75ab6ecf4f..4f04c2c4f96 100644 --- a/bdb/tcl/docs/db.html +++ b/bdb/tcl/docs/db.html @@ -1,4 +1,5 @@ -<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> +<!--Copyright 1999-2002 by Sleepycat Software, Inc.--> +<!--All rights reserved.--> <HTML> <HEAD> <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso-8859-1"> @@ -8,184 +9,154 @@ <H2> <A NAME="Database Commands"></A>Database Commands</H2> -The database commands provide a conduit into the DB method functions. -They are all fairly straightforward and I describe them in terms of their -DB functions briefly here, with a link to the DB page where appropriate. -The first set of commands are those I believe will be the primary functions -used by most databases. Some are directly related to their DB counterparts, -and some are higher level functions that are useful to provide the user. -<P><B>> berkdb open [-env <I>env</I>]</B> -<BR><B> [-btree|-hash|-recno|-queue|-unknown]</B> -<BR><B> [-create] [-excl] [-nommap] [-rdonly] [-truncate] -[-mode -<I>mode</I>] [-errfile <I>filename</I>]</B> -<BR><B> [-dup] [-dupsort] [-recnum] [-renumber] [-revsplitoff] -[-snapshot]</B> -<BR><B> [-extent <I>size</I>]</B> -<BR><B> [-ffactor <I>density</I>]</B> -<BR><B> [-nelem <I>size</I>]</B> -<BR><B> [-lorder <I>order</I>]</B> -<BR><B> [-delim <I>delim</I>]</B> -<BR><B> [-len <I>len</I>]</B> -<BR><B> [-pad <I>pad</I>]</B> -<BR><B> [-source <I>file</I>]</B> -<BR><B> [-minkey <I>minkey</I>]</B> -<BR><B> [-cachesize {<I>gbytes bytes ncaches</I>}]</B> -<BR><B> [-pagesize <I>pagesize</I>]</B> -<BR><B> [--]</B> -<BR><B> [<I>filename </I>[<I>subdbname</I>]]</B> -<P>This command will invoke the <A HREF="../../docs/api_c/db_create.html">db_create</A> -function. If the command is given the <B>-env</B> option, then we -will accordingly creating the database within the context of that environment. -After it successfully gets a handle to a database, we bind it to a new -Tcl command of the form <B><I>dbX, </I></B>where X is an integer starting -at 0 (e.g. <B>db0, db1, </B>etc). We use the <I>Tcl_CreateObjCommand() </I> -to create the top level database function. It is through this handle -that the user can access all of the commands described in the <A HREF="#Database Commands">Database -Commands</A> section. Internally, the database handle is sent as -the <I>ClientData</I> portion of the new command set so that all future -database calls access the appropriate handle. -<P>After parsing all of the optional arguments affecting the setup of the -database and making the appropriate calls to DB to manipulate those values, -we open the database for the user. It translates to the -<A HREF="../../docs/api_c/db_open.html">DB->open</A> -method call after parsing all of the various optional arguments. -We automatically set the DB_THREAD flag. The arguments are: -<UL> -<LI> -<B>-- </B>- Terminate the list of options and use remaining arguments as -the file or subdb names (thus allowing the use of filenames beginning with -a dash '-')</LI> - -<LI> -<B>-btree</B> - DB_BTREE database</LI> - -<LI> -<B>-hash</B> - DB_HASH database</LI> - -<LI> -<B>-recno </B> - DB_RECNO database</LI> - -<LI> -<B>-queue</B> - DB_QUEUE database</LI> - -<LI> -<B>-create</B> selects the DB_CREATE flag to create underlying files</LI> - -<LI> -<B>-excl</B> selects the DB_EXCL flag to exclusively create underlying -files</LI> - -<LI> -<B>-nommap</B> selects the DB_NOMMAP flag to forbid mmaping of files</LI> - -<LI> -<B>-rdonly</B> selects the DB_RDONLY flag for opening in read-only mode</LI> - -<LI> -<B>-truncate</B> selects the DB_TRUNCATE flag to truncate the database</LI> - -<LI> -<B>-mode<I> mode</I></B> specifies the mode for created files</LI> - -<LI> -<B>-errfile </B>specifies the error file to use for this environment to -<B><I>filename</I></B> -by calling <A HREF="../../docs/api_c/db_set_errfile.html">DB->set_errfile</A><B><I>. -</I></B>If -the file already exists then we will append to the end of the file</LI> - -<LI> -<B>-dup </B>selects the DB_DUP flag to permit duplicates in the database</LI> - -<LI> -<B>-dupsort</B> selects the DB_DUPSORT flag to support sorted duplicates</LI> - -<LI> -<B>-recnum</B> selects the DB_RECNUM flag to support record numbers in -btrees</LI> - -<LI> -<B>-renumber </B>selects the DB_RENUMBER flag to support mutable record -numbers</LI> +The database commands provide a fairly straightforward mapping to the +DB method functions. -<LI> -<B>-revsplitoff </B>selects the DB_REVSPLITOFF flag to suppress reverse -splitting of pages on deletion</LI> - -<LI> -<B>-snapshot </B>selects the DB_SNAPSHOT flag to support database snapshots</LI> - -<LI> -<B>-extent </B>sets the size of a Queue database extent to the given <B><I>size -</I></B>using -the <A HREF="../../docs/api_c/db_set_q_extentsize.html">DB->set_q_extentsize</A> -method</LI> - -<LI> -<B>-ffactor</B> sets the hash table key density to the given <B><I>density -</I></B>using -the <A HREF="../../docs/api_c/db_set_h_ffactor.html">DB->set_h_ffactor</A> -method</LI> - -<LI> -<B>-nelem </B>sets the hash table size estimate to the given <B><I>size -</I></B>using -the <A HREF="../../docs/api_c/db_set_h_nelem.html">DB->set_h_nelem</A> -method</LI> - -<LI> -<B>-lorder </B>sets the byte order for integers stored in the database -meta-data to the given <B><I>order</I></B> using the <A HREF="../../docs/api_c/db_set_lorder.html">DB->set_lorder</A> -method</LI> - -<LI> -<B>-delim </B>sets the delimiting byte for variable length records to -<B><I>delim</I></B> -using the <A HREF="../../docs/api_c/db_set_re_delim.html">DB->set_re_delim</A> -method</LI> - -<LI> -<B>-len </B>sets the length of fixed-length records to <B><I>len</I></B> -using the <A HREF="../../docs/api_c/db_set_re_len.html">DB->set_re_len</A> -method</LI> - -<LI> -<B>-pad </B>sets the pad character used for fixed length records to -<B><I>pad</I></B> -using the <A HREF="../../docs/db_set_re_pad.html">DB->set_re_pad</A> method</LI> - -<LI> -<B>-source </B>sets the backing source file name to <B><I>file</I></B> -using the <A HREF="../../docs/api_c/db_set_re_source.html">DB->set_re_source</A> -method</LI> - -<LI> -<B>-minkey </B>sets the minimum number of keys per Btree page to <B><I>minkey</I></B> -using the <A HREF="../../docs/api_c/db_set_bt_minkey.html">DB->set_bt_minkey</A> -method</LI> - -<LI> -<B>-cachesize </B>sets the size of the database cache to the size -specified by <B><I>gbytes </I></B>and <B><I>bytes, </I></B>broken up into -<B><I>ncaches</I></B> -number of caches using the <A HREF="../../docs/api_c/db_set_cachesize.html">DB->set_cachesize</A> -method</LI> - -<LI> -<B>-pagesize </B>sets the size of the database page to <B><I>pagesize </I></B>using -the <A HREF="../../docs/api_c/db_set_pagesize.html">DB->set_pagesize</A> -method</LI> - -<LI> -<B><I>filename</I></B> indicates the name of the database</LI> - -<LI> -<B><I>subdbname</I></B> indicate the name of the sub-database</LI> -</UL> +<P> +<B>> berkdb open</B> +<dl> + +<dt><B>[-btcompare <I>proc</I>]</B><dd> +Sets the Btree comparison function to the Tcl procedure named +<I>proc</I> using the +<A HREF="../../docs/api_c/db_set_bt_compare.html">DB->set_bt_compare</A> +method. + +<dt><B>[-btree|-hash|-recno|-queue|-unknown]</B><dd> +</td><td> +Select the database type:<br> +DB_BTREE, DB_HASH, DB_RECNO, DB_QUEUE or DB_UNKNOWN. + + +<dt><B>[-cachesize {<I>gbytes bytes ncaches</I>}]</B><dd> +Sets the size of the database cache to the size specified by +<I>gbytes</I> and <I>bytes</I>, broken up into <I>ncaches</I> number of +caches using the +<A HREF="../../docs/api_c/db_set_cachesize.html">DB->set_cachesize</A> +method. + +<dt><B>[-create]</B><dd> +Selects the DB_CREATE flag to create underlying files. + +<dt><B>[-delim <I>delim</I>]</B><dd> +Sets the delimiting byte for variable length records to <I>delim</I> +using the +<A HREF="../../docs/api_c/db_set_re_delim.html">DB->set_re_delim</A> +method. + +<dt><B>[-dup]</B><dd> +Selects the DB_DUP flag to permit duplicates in the database. + +<dt><B>[-dupcompare <I>proc</I>]</B><dd> +Sets the duplicate data comparison function to the Tcl procedure named +<I>proc</I> using the +<A HREF="../../docs/api_c/db_set_dup_compare.html">DB->set_dup_compare</A> +method. + +<dt><B>[-dupsort]</B><dd> +Selects the DB_DUPSORT flag to support sorted duplicates. + +<dt><B>[-env <I>env</I>]</B><dd> +The database environment. + +<dt><B>[-errfile <I>filename</I>]</B><dd> +Specifies the error file to use for this environment to <I>filename</I> +by calling +<A HREF="../../docs/api_c/db_set_errfile.html">DB->set_errfile</A>. +If the file already exists then we will append to the end of the file. + +<dt><B>[-excl]</B><dd> +Selects the DB_EXCL flag to exclusively create underlying files. + +<dt><B>[-extent <I>size</I>]</B><dd> +Sets the size of a Queue database extent to the given <I>size</I> using +the +<A HREF="../../docs/api_c/db_set_q_extentsize.html">DB->set_q_extentsize</A> +method. + +<dt><B>[-ffactor <I>density</I>]</B><dd> +Sets the hash table key density to the given <I>density</I> using the +<A HREF="../../docs/api_c/db_set_h_ffactor.html">DB->set_h_ffactor</A> +method. + +<dt><B>[-hashproc <I>proc</I>]</B><dd> +Sets a user-defined hash function to the Tcl procedure named <I>proc</I> +using the +<A HREF="../../docs/api_c/db_set_h_hash.html">DB->set_h_hash</A> method. + +<dt><B>[-len <I>len</I>]</B><dd> +Sets the length of fixed-length records to <I>len</I> using the +<A HREF="../../docs/api_c/db_set_re_len.html">DB->set_re_len</A> +method. + +<dt><B>[-lorder <I>order</I>]</B><dd> +Sets the byte order for integers stored in the database meta-data to +the given <I>order</I> using the +<A HREF="../../docs/api_c/db_set_lorder.html">DB->set_lorder</A> +method. + +<dt><B>[-minkey <I>minkey</I>]</B><dd> +Sets the minimum number of keys per Btree page to <I>minkey</I> using +the +<A HREF="../../docs/api_c/db_set_bt_minkey.html">DB->set_bt_minkey</A> +method. + +<dt><B>[-mode <I>mode</I>]</B><dd> +Specifies the mode for created files. + +<dt><B>[-nelem <I>size</I>]</B><dd> +Sets the hash table size estimate to the given <I>size</I> using the +<A HREF="../../docs/api_c/db_set_h_nelem.html">DB->set_h_nelem</A> +method. + +<dt><B>[-nommap]</B><dd> +Selects the DB_NOMMAP flag to forbid mmaping of files. + +<dt><B>[-pad <I>pad</I>]</B><dd> +Sets the pad character used for fixed length records to <I>pad</I> using +the +<A HREF="../../docs/db_set_re_pad.html">DB->set_re_pad</A> method. + +<dt><B>[-pagesize <I>pagesize</I>]</B><dd> +Sets the size of the database page to <I>pagesize</I> using the +<A HREF="../../docs/api_c/db_set_pagesize.html">DB->set_pagesize</A> +method. + +<dt><B>[-rdonly]</B><dd> +Selects the DB_RDONLY flag for opening in read-only mode. + +<dt><B>[-recnum]</B><dd> +Selects the DB_RECNUM flag to support record numbers in Btrees. + +<dt><B>[-renumber]</B><dd> +Selects the DB_RENUMBER flag to support mutable record numbers. + +<dt><B>[-revsplitoff]</B><dd> +Selects the DB_REVSPLITOFF flag to suppress reverse splitting of pages +on deletion. + +<dt><B>[-snapshot]</B><dd> +Selects the DB_SNAPSHOT flag to support database snapshots. + +<dt><B>[-source <I>file</I>]</B><dd> +Sets the backing source file name to <I>file</I> using the +<A HREF="../../docs/api_c/db_set_re_source.html">DB->set_re_source</A> +method. + +<dt><B>[-truncate]</B><dd> +Selects the DB_TRUNCATE flag to truncate the database. + +<dt><B>[--]</B><dd> +Terminate the list of options and use remaining arguments as the file +or subdb names (thus allowing the use of filenames beginning with a dash +'-'). + +<dt><B>[<I>filename </I>[<I>subdbname</I>]]</B><dd> +The names of the database and sub-database. +</dl> <HR WIDTH="100%"> -<BR><B> berkdb upgrade [-dupsort] [-env <I>env</I>] [--] [<I>filename</I>]</B> +<B>> berkdb upgrade [-dupsort] [-env <I>env</I>] [--] [<I>filename</I>]</B> <P>This command will invoke the <A HREF="../../docs/api_c/db_upgrade.html">DB->upgrade</A> function. If the command is given the <B>-env</B> option, then we will accordingly upgrade the database filename within the context of that @@ -193,14 +164,21 @@ environment. The <B>-dupsort</B> option selects the DB_DUPSORT flag for upgrading. The use of --<B> </B>terminates the list of options, thus allowing filenames beginning with a dash. <P> -<HR WIDTH="100%"><B>> berkdb verify [-env <I>env</I>] [--] [<I>filename</I>]</B> + +<HR WIDTH="100%"> +<B>> berkdb verify [-env <I>env</I>] [--] [<I>filename</I>]</B> <P>This command will invoke the <A HREF="../../docs/api_c/db_verify.html">DB->verify</A> function. If the command is given the <B>-env</B> option, then we will accordingly verify the database filename within the context of that environment. The use of --<B> </B>terminates the list of options, thus allowing filenames beginning with a dash. <P> -<HR WIDTH="100%"><B>> <I>db</I> join [-nosort] <I>db0.c0 db1.c0</I> ...</B> + +<HR WIDTH="100%"><B>> <I>db</I> del</B> +<P>There are no undocumented options. + +<HR WIDTH="100%"> +<B>> <I>db</I> join [-nosort] <I>db0.c0 db1.c0</I> ...</B> <P>This command will invoke the <A HREF="../../docs/api_c/db_join.html">db_join</A> function. After it successfully joins a database, we bind it to a new Tcl command of the form <B><I>dbN.cX, </I></B>where X is an integer @@ -215,7 +193,33 @@ number of data items they reference. It results in the DB_JOIN_NOSORT flag being set.</LI> </UL> -<HR WIDTH="100%"><B>> <I>db</I> get_join [-nosort] {db key} {db key} ...</B> +<P> +This command will invoke the +<A HREF="../../docs/api_c/db_create.html">db_create</A> function. If +the command is given the <B>-env</B> option, then we will accordingly +creating the database within the context of that environment. After it +successfully gets a handle to a database, we bind it to a new Tcl +command of the form <B><I>dbX, </I></B>where X is an integer starting +at 0 (e.g. <B>db0, db1, </B>etc). + +<p> +We use the <I>Tcl_CreateObjCommand()</I> to create the top level +database function. It is through this handle that the user can access +all of the commands described in the <A HREF="#Database Commands"> +Database Commands</A> section. Internally, the database handle +is sent as the <I>ClientData</I> portion of the new command set so that +all future database calls access the appropriate handle. + +<P> +After parsing all of the optional arguments affecting the setup of the +database and making the appropriate calls to DB to manipulate those +values, we open the database for the user. It translates to the +<A HREF="../../docs/api_c/db_open.html">DB->open</A> method call after +parsing all of the various optional arguments. We automatically set the +DB_THREAD flag. The arguments are: + +<HR WIDTH="100%"> +<B>> <I>db</I> get_join [-nosort] {db key} {db key} ...</B> <P>This command performs a join operation on the keys specified and returns a list of the joined {key data} pairs. <P>The options are: @@ -226,41 +230,34 @@ number of data items they reference. It results in the DB_JOIN_NOSORT flag being set.</LI> </UL> -<HR WIDTH="100%"><B>> <I>db</I> keyrange [-txn <I>id</I>] key</B> +<HR WIDTH="100%"> +<B>> <I>db</I> keyrange [-txn <I>id</I>] key</B> <P>This command returns the range for the given <B>key</B>. It returns a list of 3 double elements of the form {<B><I>less equal greater</I></B>} where <B><I>less</I></B> is the percentage of keys less than the given key, <B><I>equal</I></B> is the percentage equal to the given key and <B><I>greater</I></B> is the percentage greater than the given key. If the -txn option is specified it performs this operation under transaction protection. -<BR> -<HR WIDTH="100%"><B>> <I>db</I> put</B> -<P>The <B>undocumented</B> options are: -<UL> -<LI> -<B>-nodupdata</B> This flag causes DB not to insert the key/data pair if -it already exists, that is, both the key and data items are already in -the database. The -nodupdata flag may only be specified if the underlying -database has been configured to support sorted duplicates.</LI> -</UL> -<HR WIDTH="100%"><B>> <I>db</I> stat</B> +<HR WIDTH="100%"><B>> <I>db</I> put</B> <P>The <B>undocumented</B> options are: -<UL> -<LI> -<B>-cachedcounts</B> This flag causes DB to return the cached key/record -counts, similar to the DB_CACHED_COUNTS flags to DB->stat.</LI> -</UL> +<dl> +<dt><B>-nodupdata</B><dd> +This flag causes DB not to insert the key/data pair if it already +exists, that is, both the key and data items are already in the +database. The -nodupdata flag may only be specified if the underlying +database has been configured to support sorted duplicates. +</dl> <HR WIDTH="100%"><B>> <I>dbc</I> put</B> <P>The <B>undocumented</B> options are: -<UL> -<LI> -<B>-nodupdata</B> This flag causes DB not to insert the key/data pair if -it already exists, that is, both the key and data items are already in -the database. The -nodupdata flag may only be specified if the underlying -database has been configured to support sorted duplicates.</LI> -</UL> +<dl> +<dt><B>-nodupdata</B><dd> +This flag causes DB not to insert the key/data pair if it already +exists, that is, both the key and data items are already in the +database. The -nodupdata flag may only be specified if the underlying +database has been configured to support sorted duplicates. +</dl> </BODY> </HTML> diff --git a/bdb/tcl/docs/env.html b/bdb/tcl/docs/env.html index a1bd08fd163..79c349841ac 100644 --- a/bdb/tcl/docs/env.html +++ b/bdb/tcl/docs/env.html @@ -1,303 +1,354 @@ -<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> -<HTML> -<HEAD> - <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso-8859-1"> - <META NAME="GENERATOR" CONTENT="Mozilla/4.08 [en] (X11; I; FreeBSD 3.3-RELEASE i386) [Netscape]"> -</HEAD> -<BODY> - -<H2> -Environment Commands</H2> +<!--Copyright 1999-2002 by Sleepycat Software, Inc.--> +<!--All rights reserved.--> +<html> +<head> + <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1"> + <meta name="GENERATOR" content="Mozilla/4.75 [en] (X11; U; Linux 2.2.16-22 i686) [Netscape]"> +</head> +<body> + +<h2> +Environment Commands</h2> Environments provide a structure for creating a consistent environment for processes using one or more of the features of Berkeley DB. Unlike some of the database commands, the environment commands are very low level. -<BR> -<HR WIDTH="100%"> -<P>The user may create and open a new DB environment by invoking: -<P><B>> berkdb env</B> -<BR><B> [-cdb] [-cdb_alldb] [-lock] [-log] [-txn [nosync]]</B> -<BR><B> [-create] [-home<I> directory</I>] [-mode <I>mode</I>]</B> -<BR><B> [-data_dir <I>directory</I>] [-log_dir <I>directory</I>] -[-tmp_dir <I>directory</I>]</B> -<BR><B> [-nommap] [-private] [-recover] [-recover_fatal] -[-system_mem] [-errfile <I>filename</I>]</B> -<BR><B> [-use_environ] [-use_environ_root] [-verbose -{<I>which </I>on|off}]</B> -<BR><B> [-region_init]</B> -<BR><B> [-cachesize {<I>gbytes bytes ncaches</I>}]</B> -<BR><B> [-mmapsize<I> size</I>]</B> -<BR><B> [-log_max <I>max</I>]</B> -<BR><B> [-log_buffer <I>size</I>]</B> -<BR><B> [-lock_conflict {<I>nmodes </I>{<I>matrix</I>}}]</B> -<BR><B> [-lock_detect default|oldest|random|youngest]</B> -<BR><B> [-lock_max <I>max</I>]</B> -<BR><B> [-lock_max_locks <I>max</I>]</B> -<BR><B> [-lock_max_lockers <I>max</I>]</B> -<BR><B> [-lock_max_objects <I>max</I>]</B> -<BR><B> [-txn_max <I>max</I>]</B> -<BR><B> [-client_timeout <I>seconds</I>]</B> -<BR><B> [-server_timeout <I>seconds</I>]</B> -<BR><B> [-server <I>hostname</I>]</B> -<BR> -<P>This command opens up an environment. We automatically set +<br> +<hr WIDTH="100%"> +<p>The user may create and open a new DB environment by invoking: +<p><b>> berkdb env</b> +<br><b> [-cdb] [-cdb_alldb] [-lock] [-log] [-txn [nosync]]</b> +<br><b> [-create] [-home<i> directory</i>] [-mode <i>mode</i>]</b> +<br><b> [-data_dir <i>directory</i>] [-log_dir <i>directory</i>] +[-tmp_dir <i>directory</i>]</b> +<br><b> [-nommap] [-private] [-recover] [-recover_fatal] +[-system_mem] [-errfile <i>filename</i>]</b> +<br><b> [-use_environ] [-use_environ_root] [-verbose +{<i>which </i>on|off}]</b> +<br><b> [-region_init]</b> +<br><b> [-cachesize {<i>gbytes bytes ncaches</i>}]</b> +<br><b> [-mmapsize<i> size</i>]</b> +<br><b> [-log_max <i>max</i>]</b> +<br><b> [-log_buffer <i>size</i>]</b> +<br><b> [-lock_conflict {<i>nmodes </i>{<i>matrix</i>}}]</b> +<br><b> [-lock_detect default|oldest|random|youngest]</b> +<br><b> [-lock_max <i>max</i>]</b> +<br><b> [-lock_max_locks <i>max</i>]</b> +<br><b> [-lock_max_lockers <i>max</i>]</b> +<br><b> [-lock_max_objects <i>max</i>]</b> +<br><b> [-lock_timeout <i>timeout</i>]</b> +<br><b> [-overwrite]</b> +<br><b> [-txn_max <i>max</i>]</b> +<br><b> [-txn_timeout <i>timeout</i>]</b> +<br><b> [-client_timeout <i>seconds</i>]</b> +<br><b> [-server_timeout <i>seconds</i>]</b> +<br><b> [-server <i>hostname</i>]</b> +<br><b> [-rep_master] [-rep_client]</b> +<br><b> [-rep_transport <i>{ machineid sendproc }</i>]</b> +<br> +<p>This command opens up an environment. We automatically set the DB_THREAD and the DB_INIT_MPOOL flags. The arguments are: -<UL> -<LI> -<B>-cdb</B> selects the DB_INIT_CDB flag for Concurrent Data Store</LI> - -<LI> -<B>-cdb_alldb</B> selects the DB_CDB_ALLDB flag for Concurrent Data Store</LI> - -<LI> -<B>-lock</B> selects the DB_INIT_LOCK flag for the locking subsystem</LI> - -<LI> -<B>-log</B> selects the DB_INIT_LOG flag for the logging subsystem</LI> - -<LI> -<B>-txn</B> selects the DB_INIT_TXN, DB_INIT_LOCK and DB_INIT_LOG flags -for the transaction subsystem. If <B>nosync</B> is specified, then -it will also select DB_TXN_NOSYNC to indicate no flushes of log on commits</LI> - -<LI> -<B>-create </B>selects the DB_CREATE flag to create underlying files</LI> - -<LI> -<B>-home <I>directory </I></B>selects the home directory of the environment</LI> - -<LI> -<B>-data_dir <I>directory </I></B>selects the data file directory of the -environment by calling <A HREF="../../docs/api_c/env_set_data_dir.html">DBENV->set_data_dir</A>.</LI> - -<LI> -<B>-log_dir <I>directory </I></B>selects the log file directory of the -environment by calling <A HREF="../../docs/api_c/env_set_lg_dir.html">DBENV->set_lg_dir</A>.</LI> - -<LI> -<B>-tmp_dir <I>directory </I></B>selects the temporary file directory of -the environment by calling <A HREF="../../docs/api_c/env_set_tmp_dir.so">DBENV->set_tmp_dir</A>.</LI> - -<LI> -<B>-mode <I>mode </I></B>sets the permissions of created files to <B><I>mode</I></B></LI> - -<LI> -<B>-nommap</B> selects the DB_NOMMAP flag to disallow using mmap'ed files</LI> - -<LI> -<B>-private</B> selects the DB_PRIVATE flag for a private environment</LI> - -<LI> -<B>-recover</B> selects the DB_RECOVER flag for recovery</LI> - -<LI> -<B>-recover_fatal</B> selects the DB_RECOVER_FATAL flag for catastrophic -recovery</LI> - -<LI> -<B>-system_mem</B> selects the DB_SYSTEM_MEM flag to use system memory</LI> - -<LI> -<B>-errfile </B>specifies the error file to use for this environment to -<B><I>filename</I></B> -by calling <A HREF="../../docs/api_c/env_set_errfile.html">DBENV->set_errfile</A><B><I>. -</I></B>If -the file already exists then we will append to the end of the file</LI> - -<LI> -<B>-use_environ</B> selects the DB_USE_ENVIRON flag to affect file naming</LI> - -<LI> -<B>-use_environ_root</B> selects the DB_USE_ENVIRON_ROOT flag to have the -root environment affect file naming</LI> - -<LI> -<B>-verbose</B> produces verbose error output for the given which subsystem, -using the <A HREF="../../docs/api_c/dbenv_set_verbose.html">DBENV->set_verbose</A> -method. See the description of <A HREF="#> <env> verbose which on|off">verbose</A> -below for valid <B><I>which </I></B>values</LI> - -<LI> -<B>-region_init </B>specifies that the user wants to page fault the region -in on startup using the <A HREF="../../docs/api_c/env_set_region_init.html">DBENV->set_region_init</A> -method call</LI> - -<LI> -<B>-cachesize </B>sets the size of the database cache to the size -specified by <B><I>gbytes </I></B>and <B><I>bytes, </I></B>broken up into -<B><I>ncaches</I></B> -number of caches using the <A HREF="../../docs/api_c/env_set_cachesize.html">DBENV->set_cachesize</A> -method</LI> - -<LI> -<B>-mmapsize </B>sets the size of the database page to <B><I>size </I></B>using -the <A HREF="../../docs/api_c/env_set_mp_mmapsize.html">DBENV->set_mp_mmapsize</A> -method</LI> - -<LI> -<B>-log_max </B>sets the maximum size of the log file to <B><I>max</I></B> -using the <A HREF="../../docs/api_c/env_set_lg_max.html">DBENV->set_lg_max</A> -call</LI> - -<LI> -<B>-log_buffer </B>sets the size of the log file in bytes to <B><I>size</I></B> -using the <A HREF="../../docs/api_c/env_set_lg_bsize.html">DBENV->set_lg_bsize</A> -call</LI> - -<LI> -<B>-lock_conflict </B>sets the number of lock modes to <B><I>nmodes</I></B> -and sets the locking policy for those modes to the <B><I>conflict_matrix</I></B> -given using the <A HREF="../../docs/api_c/env_set_lk_conflict.html">DBENV->set_lk_conflict</A> -method call</LI> - -<LI> -<B>-lock_detect </B>sets the deadlock detection policy to the given policy -using the <A HREF="../../docs/env_set_lk_detect.html">DBENV->set_lk_detect</A> -method call. The policy choices are:</LI> - -<UL> -<LI> -<B>default</B> selects the DB_LOCK_DEFAULT policy for default detection</LI> - -<LI> -<B>oldest </B>selects DB_LOCK_OLDEST to abort the oldest locker on a deadlock</LI> - -<LI> -<B>random</B> selects DB_LOCK_RANDOM to abort a random locker on a deadlock</LI> - -<LI> -<B>youngest</B> selects DB_LOCK_YOUNGEST to abort the youngest locker on -a deadlock</LI> -</UL> - -<LI> -<B>-lock_max </B>sets the maximum size of the lock table to <B><I>max </I></B>using -the <A HREF="../../docs/api_c/env_set_lk_max.html">DBENV->set_lk_max</A> -method call</LI> - -<LI> -<B>-lock_max_locks </B>sets the maximum number of locks to <B><I>max </I></B>using -the <A HREF="../../docs/api_c/env_set_lk_max_locks.html">DBENV->set_lk_max_locks</A> -method call</LI> - -<LI> -<B>-lock_max_lockers </B>sets the maximum number of locking entities to -<B><I>max </I></B>using the <A HREF="../../docs/api_c/env_set_lk_max_lockers.html">DBENV->set_lk_max_lockers</A> -method call</LI> - -<LI> -<B>-lock_max_objects </B>sets the maximum number of simultaneously locked -objects to <B><I>max </I></B>using the <A HREF="../../docs/api_c/env_set_lk_max_objects.html">DBENV->set_lk_max_objects</A> -method call</LI> - -<LI> -<B>-txn_max </B>sets the maximum size of the transaction table to <B><I>max</I></B> -using the <A HREF="../../docs/api_c/env_set_txn_max.html">DBENV->set_txn_max</A> -method call</LI> - -<LI> -<B>-client_timeout</B> sets the timeout value for the client waiting for -a reply from the server for RPC operations to <B><I>seconds</I></B>.</LI> - -<LI> -<B>-server_timeout</B> sets the timeout value for the server to determine -an idle client is gone to <B><I>seconds</I></B>.</LI> - -<LI> -<B> -server </B>specifies the <B><I>hostname</I></B> of the server -to connect to in the <A HREF="../../docs/api_c/env_set_server.html">DBENV->set_server</A> -call.</LI> -</UL> -This command will invoke the <A HREF="../../docs/api_c/env_create.html">db_env_create</A> +<ul> +<li> +<b>-cdb</b> selects the DB_INIT_CDB flag for Concurrent Data Store</li> + +<li> +<b>-cdb_alldb</b> selects the DB_CDB_ALLDB flag for Concurrent Data Store</li> + +<li> +<b>-lock</b> selects the DB_INIT_LOCK flag for the locking subsystem</li> + +<li> +<b>-log</b> selects the DB_INIT_LOG flag for the logging subsystem</li> + +<li> +<b>-txn</b> selects the DB_INIT_TXN, DB_INIT_LOCK and DB_INIT_LOG flags +for the transaction subsystem. If <b>nosync</b> is specified, then +it will also select DB_TXN_NOSYNC to indicate no flushes of log on commits</li> + +<li> +<b>-create </b>selects the DB_CREATE flag to create underlying files</li> + +<li> +<b>-home <i>directory </i></b>selects the home directory of the environment</li> + +<li> +<b>-data_dir <i>directory </i></b>selects the data file directory of the +environment by calling <a href="../../docs/api_c/env_set_data_dir.html">DBENV->set_data_dir</a>.</li> + +<li> +<b>-log_dir <i>directory </i></b>selects the log file directory of the +environment by calling <a href="../../docs/api_c/env_set_lg_dir.html">DBENV->set_lg_dir</a>.</li> + +<li> +<b>-tmp_dir <i>directory </i></b>selects the temporary file directory of +the environment by calling <a href="../../docs/api_c/env_set_tmp_dir.so">DBENV->set_tmp_dir</a>.</li> + +<li> +<b>-mode <i>mode </i></b>sets the permissions of created files to <b><i>mode</i></b></li> + +<li> +<b>-nommap</b> selects the DB_NOMMAP flag to disallow using mmap'ed files</li> + +<li> +<b>-private</b> selects the DB_PRIVATE flag for a private environment</li> + +<li> +<b>-recover</b> selects the DB_RECOVER flag for recovery</li> + +<li> +<b>-recover_fatal</b> selects the DB_RECOVER_FATAL flag for catastrophic +recovery</li> + +<li> +<b>-system_mem</b> selects the DB_SYSTEM_MEM flag to use system memory</li> + +<li> +<b>-errfile </b>specifies the error file to use for this environment to +<b><i>filename</i></b> +by calling <a href="../../docs/api_c/env_set_errfile.html">DBENV->set_errfile</a><b><i>. +</i></b>If +the file already exists then we will append to the end of the file</li> + +<li> +<b>-use_environ</b> selects the DB_USE_ENVIRON flag to affect file naming</li> + +<li> +<b>-use_environ_root</b> selects the DB_USE_ENVIRON_ROOT flag to have the +root environment affect file naming</li> + +<li> +<b>-verbose</b> produces verbose error output for the given which subsystem, +using the <a href="../../docs/api_c/dbenv_set_verbose.html">DBENV->set_verbose</a> +method. See the description of <a href="#> <env> verbose which on|off">verbose</a> +below for valid <b><i>which </i></b>values</li> + +<li> +<b>-region_init </b>specifies that the user wants to page fault the region +in on startup using the <a href="../../docs/api_c/env_set_region_init.html">DBENV->set_region_init</a> +method call</li> + +<li> +<b>-cachesize </b>sets the size of the database cache to the size +specified by <b><i>gbytes </i></b>and <b><i>bytes, </i></b>broken up into +<b><i>ncaches</i></b> +number of caches using the <a href="../../docs/api_c/env_set_cachesize.html">DBENV->set_cachesize</a> +method</li> + +<li> +<b>-mmapsize </b>sets the size of the database page to <b><i>size </i></b>using +the <a href="../../docs/api_c/env_set_mp_mmapsize.html">DBENV->set_mp_mmapsize</a> +method</li> + +<li> +<b>-log_max </b>sets the maximum size of the log file to <b><i>max</i></b> +using the <a href="../../docs/api_c/env_set_lg_max.html">DBENV->set_lg_max</a> +call</li> + +<li> +<b>-log_regionmax </b>sets the size of the log region to <b><i>max</i></b> +using the <a href="../../docs/api_c/env_set_lg_regionmax.html">DBENV->set_lg_regionmax</a> +call</li> + +<li> +<b>-log_buffer </b>sets the size of the log file in bytes to <b><i>size</i></b> +using the <a href="../../docs/api_c/env_set_lg_bsize.html">DBENV->set_lg_bsize</a> +call</li> + +<li> +<b>-lock_conflict </b>sets the number of lock modes to <b><i>nmodes</i></b> +and sets the locking policy for those modes to the <b><i>conflict_matrix</i></b> +given using the <a href="../../docs/api_c/env_set_lk_conflict.html">DBENV->set_lk_conflict</a> +method call</li> + +<li> +<b>-lock_detect </b>sets the deadlock detection policy to the given policy +using the <a href="../../docs/env_set_lk_detect.html">DBENV->set_lk_detect</a> +method call. The policy choices are:</li> + +<ul> +<li> +<b>default</b> selects the DB_LOCK_DEFAULT policy for default detection</li> + +<li> +<b>oldest </b>selects DB_LOCK_OLDEST to abort the oldest locker on a deadlock</li> + +<li> +<b>random</b> selects DB_LOCK_RANDOM to abort a random locker on a deadlock</li> + +<li> +<b>youngest</b> selects DB_LOCK_YOUNGEST to abort the youngest locker on +a deadlock</li> +</ul> + +<li> +<b>-lock_max </b>sets the maximum size of the lock table to <b><i>max </i></b>using +the <a href="../../docs/api_c/env_set_lk_max.html">DBENV->set_lk_max</a> +method call</li> + +<li> +<b>-lock_max_locks </b>sets the maximum number of locks to <b><i>max </i></b>using +the <a href="../../docs/api_c/env_set_lk_max_locks.html">DBENV->set_lk_max_locks</a> +method call</li> + +<li> +<b>-lock_max_lockers </b>sets the maximum number of locking entities to +<b><i>max +</i></b>using the <a href="../../docs/api_c/env_set_lk_max_lockers.html">DBENV->set_lk_max_lockers</a> +method call</li> + +<li> +<b>-lock_max_objects </b>sets the maximum number of simultaneously locked +objects to <b><i>max </i></b>using the <a href="../../docs/api_c/env_set_lk_max_objects.html">DBENV->set_lk_max_objects</a> +method call</li> + +<li> +<b>-lock_timeout </b>sets the timeout for locks in the environment</li> + +<li> +<b>-overwrite </b>sets DB_OVERWRITE flag</li> + +<li> +<b>-txn_max </b>sets the maximum size of the transaction table to <b><i>max</i></b> +using the <a href="../../docs/api_c/env_set_txn_max.html">DBENV->set_txn_max</a> +method call</li> + +<li> +<b>-txn_timeout </b>sets the timeout for transactions in the environment</li> + +<li> +<b>-client_timeout</b> sets the timeout value for the client waiting for +a reply from the server for RPC operations to <b><i>seconds</i></b>.</li> + +<li> +<b>-server_timeout</b> sets the timeout value for the server to determine +an idle client is gone to <b><i>seconds</i></b>.</li> + +<li> +<b>-server </b>specifies the <b><i>hostname</i></b> of the server +to connect to in the <a href="../../docs/api_c/env_set_server.html">DBENV->set_server</a> +call.</li> + +<li> +<b>-rep_client </b>sets the newly created environment to be a +replication client, using the <a href="../../docs/api_c/rep_client.html"> +DBENV->rep_client</a> call.</li> + +<li> +<b>-rep_master </b>sets the newly created environment to be a +replication master, using the <a href="../../docs/api_c/rep_master.html"> +DBENV->rep_master</a> call.</li> + +<li> +<b>-rep_transport </b>specifies the replication transport function, +using the +<a href="../../docs/api_c/rep_transport.html">DBENV->set_rep_transport</a> +call. This site's machine ID is set to <b><i>machineid</i></b> and +the send function, a Tcl proc, is set to <b><i>sendproc</i></b>.</li> + +</ul> + +This command will invoke the <a href="../../docs/api_c/env_create.html">db_env_create</a> function. After it successfully gets a handle to an environment, -we bind it to a new Tcl command of the form <B><I>envX</I></B>, where X -is an integer starting at 0 (e.g. <B>env0, env1, </B>etc). -We use the <I>Tcl_CreateObjCommand()</I> to create the top level environment +we bind it to a new Tcl command of the form <b><i>envX</i></b>, where X +is an integer starting at 0 (e.g. <b>env0, env1, </b>etc). +We use the <i>Tcl_CreateObjCommand()</i> to create the top level environment command function. It is through this handle that the user can access -all the commands described in the <A HREF="#Environment Commands">Environment -Commands</A> section. Internally, the handle we get back from DB -will be stored as the <I>ClientData</I> portion of the new command set +all the commands described in the <a href="#Environment Commands">Environment +Commands</a> section. Internally, the handle we get back from DB +will be stored as the <i>ClientData</i> portion of the new command set so that all future environment calls will have that handle readily available. -Then we call the <A HREF="../../docs/api_c/env_open.html">DBENV->open</A> +Then we call the <a href="../../docs/api_c/env_open.html">DBENV->open</a> method call and possibly some number of setup calls as described above. -<P> -<HR WIDTH="100%"> -<BR><A NAME="> <env> verbose which on|off"></A><B>> <env> verbose <I>which</I> -on|off</B> -<P>This command controls the use of debugging output for the environment. -This command directly translates to a call to the <A HREF="../../docs/api_c/dbenv_set_verbose.html">DBENV->set_verbose</A> +<p> +<hr WIDTH="100%"> +<br><a NAME="> <env> verbose which on|off"></a><b>> <env> verbose <i>which</i> +on|off</b> +<p>This command controls the use of debugging output for the environment. +This command directly translates to a call to the <a href="../../docs/api_c/dbenv_set_verbose.html">DBENV->set_verbose</a> method call. It returns either a 0 (for success), a DB error message or it throws a Tcl error with a system message. The user specifies -<B><I>which</I></B> +<b><i>which</i></b> subsystem to control, and indicates whether debug messages should be turned -<B>on</B> -or <B>off</B> for that subsystem. The value of <B><I>which</I></B> +<b>on</b> +or <b>off</b> for that subsystem. The value of <b><i>which</i></b> must be one of the following: -<UL> -<LI> -<B>chkpt</B> - Chooses the checkpointing code by using the DB_VERB_CHKPOINT -value</LI> - -<LI> -<B>deadlock </B>- Chooses the deadlocking code by using the DB_VERB_DEADLOCK -value</LI> - -<LI> -<B>recovery </B>- Chooses the recovery code by using the DB_VERB_RECOVERY -value</LI> - -<LI> -<B>wait </B>- Chooses the waitsfor code by using the DB_VERB_WAITSFOR value</LI> -</UL> - -<HR WIDTH="100%"> -<P><A NAME="> <env> close"></A><B>> <env> close</B> -<P>This command closes an environment and deletes the handle. This -command directly translates to a call to the <A HREF="../../docs/api_c/env_close.html">DBENV->close</A> +<ul> +<li> +<b>chkpt</b> - Chooses the checkpointing code by using the DB_VERB_CHKPOINT +value</li> + +<li> +<b>deadlock </b>- Chooses the deadlocking code by using the DB_VERB_DEADLOCK +value</li> + +<li> +<b>recovery </b>- Chooses the recovery code by using the DB_VERB_RECOVERY +value</li> + +<li> +<b>wait </b>- Chooses the waitsfor code by using the DB_VERB_WAITSFOR value</li> +</ul> + +<hr WIDTH="100%"> +<p><a NAME="> <env> close"></a><b>> <env> close</b> +<p>This command closes an environment and deletes the handle. This +command directly translates to a call to the <a href="../../docs/api_c/env_close.html">DBENV->close</a> method call. It returns either a 0 (for success), a DB error message or it throws a Tcl error with a system message. -<P>Additionally, since the handle is no longer valid, we will call <I>Tcl_DeleteCommand() -</I>so +<p>Additionally, since the handle is no longer valid, we will call <i>Tcl_DeleteCommand() +</i>so that further uses of the handle will be dealt with properly by Tcl itself. -<P>Also, the close command will automatically abort any <A HREF="txn.html">transactions</A> -and close any <A HREF="mpool.html">mpool</A> memory files. As such +<p>Also, the close command will automatically abort any <a href="txn.html">transactions</a> +and close any <a href="mpool.html">mpool</a> memory files. As such we must maintain a list of open transaction and mpool handles so that we -can call <I>Tcl_DeleteCommand</I> on those as well. -<P> -<HR WIDTH="100%"> -<BR><B>> berkdb envremove [-data_dir <I>directory</I>] [-force] [-home -<I>directory</I>] --log_dir <I>directory</I>] [-tmp_dir <I>directory</I>] [-use_environ] [-use_environ_root]</B> -<P>This command removes the environment if it is not in use and deletes -the handle. This command directly translates to a call to the <A HREF="../../docs/api_c/env_remove.html">DBENV->remove</A> +can call <i>Tcl_DeleteCommand</i> on those as well. +<p> +<hr WIDTH="100%"> + +<b>> berkdb envremove<br> +[-data_dir <i>directory</i>]<br> +[-force]<br> +[-home <i>directory</i>]<br> +[-log_dir <i>directory</i>]<br> +[-overwrite]<br> +[-tmp_dir <i>directory</i>]<br> +[-use_environ]<br> +[-use_environ_root]</b> + +<p>This command removes the environment if it is not in use and deletes +the handle. This command directly translates to a call to the <a href="../../docs/api_c/env_remove.html">DBENV->remove</a> method call. It returns either a 0 (for success), a DB error message or it throws a Tcl error with a system message. The arguments are: -<UL> -<LI> -<B>-force</B> selects the DB_FORCE flag to remove even if other processes -have the environment open</LI> +<ul> +<li> +<b>-force</b> selects the DB_FORCE flag to remove even if other processes +have the environment open</li> + +<li> +<b>-home <i>directory</i> </b>specifies the home directory of the environment</li> -<LI> -<B>-home <I>directory</I> </B>specifies the home directory of the environment</LI> +<li> +<b>-data_dir <i>directory </i></b>selects the data file directory of the +environment by calling <a href="../../docs/api_c/env_set_data_dir.html">DBENV->set_data_dir</a>.</li> -<LI> -<B>-data_dir <I>directory </I></B>selects the data file directory of the -environment by calling <A HREF="../../docs/api_c/env_set_data_dir.html">DBENV->set_data_dir</A>.</LI> +<li> +<b>-log_dir <i>directory </i></b>selects the log file directory of the +environment by calling <a href="../../docs/api_c/env_set_lg_dir.html">DBENV->set_lg_dir</a>.</li> -<LI> -<B>-log_dir <I>directory </I></B>selects the log file directory of the -environment by calling <A HREF="../../docs/api_c/env_set_lg_dir.html">DBENV->set_lg_dir</A>.</LI> +<li> +<b>-overwrite </b>sets DB_OVERWRITE flag</li> -<LI> -<B>-tmp_dir <I>directory </I></B>selects the temporary file directory of -the environment by calling <A HREF="../../docs/api_c/env_set_tmp_dir.so">DBENV->set_tmp_dir</A>.</LI> +<li> +<b>-tmp_dir <i>directory </i></b>selects the temporary file directory of +the environment by calling <a href="../../docs/api_c/env_set_tmp_dir.so">DBENV->set_tmp_dir</a>.</li> -<LI> -<B>-use_environ </B>selects the DB_USE_ENVIRON flag to affect file naming</LI> +<li> +<b>-use_environ </b>selects the DB_USE_ENVIRON flag to affect file naming</li> -<LI> -<B>-use_environ_root</B> selects the DB_USE_ENVIRON_ROOT flag to affect -file naming</LI> -</UL> +<li> +<b>-use_environ_root</b> selects the DB_USE_ENVIRON_ROOT flag to affect +file naming</li> +</ul> -</BODY> -</HTML> +</body> +</html> diff --git a/bdb/tcl/docs/historic.html b/bdb/tcl/docs/historic.html index 216dc456b72..85f474fbc0f 100644 --- a/bdb/tcl/docs/historic.html +++ b/bdb/tcl/docs/historic.html @@ -1,4 +1,5 @@ -<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> +<!--Copyright 1999-2002 by Sleepycat Software, Inc.--> +<!--All rights reserved.--> <HTML> <HEAD> <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso-8859-1"> diff --git a/bdb/tcl/docs/index.html b/bdb/tcl/docs/index.html index 2866c1e23db..845b6ca81e2 100644 --- a/bdb/tcl/docs/index.html +++ b/bdb/tcl/docs/index.html @@ -1,4 +1,5 @@ -<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> +<!--Copyright 1999-2002 by Sleepycat Software, Inc.--> +<!--All rights reserved.--> <HTML> <HEAD> <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso-8859-1"> @@ -29,6 +30,9 @@ Complete Tcl Interface for Berkeley DB</H1></CENTER> <A HREF="./mpool.html">Memory Pool commands</A></LI> <LI> +<A HREF="./rep.html">Replication commands</A></LI> + +<LI> <A HREF="./txn.html">Transaction commands</A></LI> </UL> diff --git a/bdb/tcl/docs/library.html b/bdb/tcl/docs/library.html index abd656d8e5d..bfb1588c3f2 100644 --- a/bdb/tcl/docs/library.html +++ b/bdb/tcl/docs/library.html @@ -1,4 +1,5 @@ -<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> +<!--Copyright 1999-2002 by Sleepycat Software, Inc.--> +<!--All rights reserved.--> <HTML> <HEAD> <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso-8859-1"> diff --git a/bdb/tcl/docs/lock.html b/bdb/tcl/docs/lock.html index 87a20e9a6bf..d65142b798b 100644 --- a/bdb/tcl/docs/lock.html +++ b/bdb/tcl/docs/lock.html @@ -1,187 +1,207 @@ -<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> -<HTML> -<HEAD> - <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso-8859-1"> - <META NAME="GENERATOR" CONTENT="Mozilla/4.08 [en] (X11; I; FreeBSD 2.2.8-19990120-SNAP i386) [Netscape]"> -</HEAD> -<BODY> - -<H2> -<A NAME="Locking Commands"></A>Locking Commands</H2> +<!--Copyright 1999-2002 by Sleepycat Software, Inc.--> +<!--All rights reserved.--> +<html> +<head> + <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1"> + <meta name="GENERATOR" content="Mozilla/4.75 [en] (X11; U; Linux 2.2.16-22 i686) [Netscape]"> +</head> +<body> + +<h2> +<a NAME="Locking Commands"></a>Locking Commands</h2> Most locking commands work with the environment handle. However, when a user gets a lock we create a new lock handle that they then use with in a similar manner to all the other handles to release the lock. We present the general locking functions first, and then those that manipulate locks. -<P><B>> <env> lock_detect [-lock_conflict] [default|oldest|youngest|random]</B> -<P>This command runs the deadlock detector. It directly translates -to the <A HREF="../../docs/api_c/lock_detect.html">lock_detect</A> DB call. +<p><b>> <env> lock_detect [default|oldest|youngest|random]</b> +<p>This command runs the deadlock detector. It directly translates +to the <a href="../../docs/api_c/lock_detect.html">lock_detect</a> DB call. It returns either a 0 (for success), a DB error message or it throws a Tcl error with a system message. The first argument sets the policy for deadlock as follows: -<UL> -<LI> -<B>default</B> selects the DB_LOCK_DEFAULT policy for default detection -(default if not specified)</LI> - -<LI> -<B>oldest </B>selects DB_LOCK_OLDEST to abort the oldest locker on a deadlock</LI> - -<LI> -<B>random</B> selects DB_LOCK_RANDOM to abort a random locker on a deadlock</LI> - -<LI> -<B>youngest</B> selects DB_LOCK_YOUNGEST to abort the youngest locker on -a deadlock</LI> -</UL> -The second argument, <B>-lock_conflict</B>, selects the DB_LOCK_CONFLICT -flag to only run the detector if a lock conflict has occurred since the -last time the detector was run. -<HR WIDTH="100%"> -<BR><B>> <env> lock_stat</B> -<P>This command returns a list of name/value pairs where the names correspond +<ul> +<li> +<b>default</b> selects the DB_LOCK_DEFAULT policy for default detection +(default if not specified)</li> + +<li> +<b>oldest </b>selects DB_LOCK_OLDEST to abort the oldest locker on a deadlock</li> + +<li> +<b>random</b> selects DB_LOCK_RANDOM to abort a random locker on a deadlock</li> + +<li> +<b>youngest</b> selects DB_LOCK_YOUNGEST to abort the youngest locker on +a deadlock</li> +</ul> + +<hr WIDTH="100%"> +<br><b>> <env> lock_stat</b> +<p>This command returns a list of name/value pairs where the names correspond to the C-structure field names of DB_LOCK_STAT and the values are the data -returned. This command is a direct translation of the <A HREF="../../docs/api_c/lock_stat.html">lock_stat</A> +returned. This command is a direct translation of the <a href="../../docs/api_c/lock_stat.html">lock_stat</a> DB call. -<HR WIDTH="100%"> -<BR><A NAME="> <env> lock_id"></A><B>> <env> lock_id</B> -<P>This command returns a unique locker ID value. It directly translates -to the <A HREF="../../docs/api_c/lock_id.html">lock_id</A> DB call. -<HR WIDTH="100%"> -<BR><A NAME="> <env> lock_get"></A><B>> <env> lock_get [-nowait]<I>lockmode -locker obj</I></B> -<P>This command gets a lock. It will invoke the <A HREF="../../docs/api_c/lock_get.html">lock_get</A> +<hr WIDTH="100%"> +<br><a NAME="> <env> lock_id"></a><b>> <env> lock_id</b> +<p>This command returns a unique locker ID value. It directly translates +to the <a href="../../docs/api_c/lock_id.html">lock_id</a> DB call. +<br> +<hr WIDTH="100%"> +<br><a NAME="> <env> lock_id"></a><b>> <env> lock_id_free </b><i>locker</i> +<p>This command frees the locker allockated by the lock_id call. It directly +translates to the <a href="../../docs/api_c/lock_id.html">lock_id_free +</a>DB +call. +<hr WIDTH="100%"> +<br><a NAME="> <env> lock_id"></a><b>> <env> lock_id_set </b><i>current +max</i> +<p>This is a diagnostic command to set the locker id that will get +allocated next and the maximum id that +<br>will trigger the id reclaim algorithm. +<hr WIDTH="100%"> +<br><a NAME="> <env> lock_get"></a><b>> <env> lock_get [-nowait]<i>lockmode +locker obj</i></b> +<p>This command gets a lock. It will invoke the <a href="../../docs/api_c/lock_get.html">lock_get</a> function. After it successfully gets a handle to a lock, we bind -it to a new Tcl command of the form <B><I>$env.lockX</I></B>, where X is -an integer starting at 0 (e.g. <B>$env.lock0, $env.lock1, </B>etc). -We use the <I>Tcl_CreateObjCommand()</I> to create the top level locking +it to a new Tcl command of the form <b><i>$env.lockX</i></b>, where X is +an integer starting at 0 (e.g. <b>$env.lock0, $env.lock1, </b>etc). +We use the <i>Tcl_CreateObjCommand()</i> to create the top level locking command function. It is through this handle that the user can release the lock. Internally, the handle we get back from DB will be stored -as the <I>ClientData</I> portion of the new command set so that future +as the <i>ClientData</i> portion of the new command set so that future locking calls will have that handle readily available. -<P>The arguments are: -<UL> -<LI> -<B><I>locker</I></B> specifies the locker ID returned from the <A HREF="#> <env> lock_id">lock_id</A> -command</LI> +<p>The arguments are: +<ul> +<li> +<b><i>locker</i></b> specifies the locker ID returned from the <a href="#> <env> lock_id">lock_id</a> +command</li> -<LI> -<B><I>obj</I></B> specifies an object to lock</LI> +<li> +<b><i>obj</i></b> specifies an object to lock</li> -<LI> -the <B><I>lock mode</I></B> is specified as one of the following:</LI> +<li> +the <b><i>lock mode</i></b> is specified as one of the following:</li> -<UL> -<LI> -<B>ng </B>specifies DB_LOCK_NG for not granted (always 0)</LI> +<ul> +<li> +<b>ng </b>specifies DB_LOCK_NG for not granted (always 0)</li> -<LI> -<B>read</B> specifies DB_LOCK_READ for a read (shared) lock</LI> +<li> +<b>read</b> specifies DB_LOCK_READ for a read (shared) lock</li> -<LI> -<B>write</B> specifies DB_LOCK_WRITE for an exclusive write lock</LI> +<li> +<b>write</b> specifies DB_LOCK_WRITE for an exclusive write lock</li> -<LI> -<B>iwrite </B>specifies DB_LOCK_IWRITE for intent for exclusive write lock</LI> +<li> +<b>iwrite </b>specifies DB_LOCK_IWRITE for intent for exclusive write lock</li> -<LI> -<B>iread </B>specifies DB_LOCK_IREAD for intent for shared read lock</LI> +<li> +<b>iread </b>specifies DB_LOCK_IREAD for intent for shared read lock</li> -<LI> -<B>iwr </B>specifies DB_LOCK_IWR for intent for eread and write lock</LI> -</UL> +<li> +<b>iwr </b>specifies DB_LOCK_IWR for intent for eread and write lock</li> +</ul> -<LI> -<B>-nowait</B> selects the DB_LOCK_NOWAIT to indicate that we do not want -to wait on the lock</LI> -</UL> +<li> +<b>-nowait</b> selects the DB_LOCK_NOWAIT to indicate that we do not want +to wait on the lock</li> +</ul> -<HR WIDTH="100%"> -<BR><B>> <lock> put</B> -<P>This command releases the lock referenced by the command. It is -a direct translation of the <A HREF="../../docs/api_c/lock_put.html">lock_put</A> +<hr WIDTH="100%"> +<br><b>> <lock> put</b> +<p>This command releases the lock referenced by the command. It is +a direct translation of the <a href="../../docs/api_c/lock_put.html">lock_put</a> function. It returns either a 0 (for success), a DB error message or it throws a Tcl error with a system message. Additionally, since the handle is no longer valid, we will call -<I>Tcl_DeleteCommand() -</I>so +<i>Tcl_DeleteCommand() +</i>so that further uses of the handle will be dealt with properly by Tcl itself. -<BR> -<HR WIDTH="100%"> -<BR><A NAME="> <env> lock_vec"></A><B>> <env> lock_vec [-nowait] <I>locker -</I>{get|put|put_all|put_obj -[<I>obj</I>] [<I>lockmode</I>] [<I>lock</I>]} ...</B> -<P>This command performs a series of lock calls. It is a direct translation -of the <A HREF="../../docs/api_c/lock_vec.html">lock_vec</A> function. +<br> +<hr WIDTH="100%"> +<br><a NAME="> <env> lock_vec"></a><b>> <env> lock_vec [-nowait] <i>locker +</i>{get|put|put_all|put_obj +[<i>obj</i>] [<i>lockmode</i>] [<i>lock</i>]} ...</b> +<p>This command performs a series of lock calls. It is a direct translation +of the <a href="../../docs/api_c/lock_vec.html">lock_vec</a> function. This command will return a list of the return values from each operation specified in the argument list. For the 'put' operations the entry in the return value list is either a 0 (for success) or an error. -For the 'get' operation, the entry is the lock widget handle, <B>$env.lockN</B> -(as described above in <A HREF="#> <env> lock_get"><env> lock_get</A>) +For the 'get' operation, the entry is the lock widget handle, <b>$env.lockN</b> +(as described above in <a href="#> <env> lock_get"><env> lock_get</a>) or an error. If an error occurs, the return list will contain the return values for all the successful operations up the erroneous one and the error code for that operation. Subsequent operations will be ignored. -<P>As for the other operations, if we are doing a 'get' we will create +<p>As for the other operations, if we are doing a 'get' we will create the commands and if we are doing a 'put' we will have to delete the commands. Additionally, we will have to do this after the call to the DB lock_vec and iterate over the results, creating and/or deleting Tcl commands. It is possible that we may return a lock widget from a get operation that -is considered invalid, if, for instance, there was a <B>put_all</B> operation +is considered invalid, if, for instance, there was a <b>put_all</b> operation performed later in the vector of operations. The arguments are: -<UL> -<LI> -<B><I>locker</I></B> specifies the locker ID returned from the <A HREF="#> <env> lock_id">lock_id</A> -command</LI> +<ul> +<li> +<b><i>locker</i></b> specifies the locker ID returned from the <a href="#> <env> lock_id">lock_id</a> +command</li> -<LI> -<B>-nowait</B> selects the DB_LOCK_NOWAIT to indicate that we do not want -to wait on the lock</LI> +<li> +<b>-nowait</b> selects the DB_LOCK_NOWAIT to indicate that we do not want +to wait on the lock</li> -<LI> +<li> the lock vectors are tuple consisting of {an operation, lock object, lock -mode, lock handle} where what is required is based on the operation desired:</LI> - -<UL> -<LI> -<B>get</B> specifes DB_LOCK_GET to get a lock. Requires a tuple <B>{get -<I>obj</I> -<I>mode</I>} -</B>where -<B><I>mode</I></B> -is:</LI> - -<UL> -<LI> -<B>ng </B>specifies DB_LOCK_NG for not granted (always 0)</LI> - -<LI> -<B>read</B> specifies DB_LOCK_READ for a read (shared) lock</LI> - -<LI> -<B>write</B> specifies DB_LOCK_WRITE for an exclusive write lock</LI> - -<LI> -<B>iwrite </B>specifies DB_LOCK_IWRITE for intent for exclusive write lock</LI> - -<LI> -<B>iread </B>specifies DB_LOCK_IREAD for intent for shared read lock</LI> - -<LI> -<B>iwr </B>specifies DB_LOCK_IWR for intent for eread and write lock</LI> -</UL> - -<LI> -<B>put</B> specifies DB_LOCK_PUT to release a <B><I>lock</I></B>. -Requires a tuple <B>{put <I>lock}</I></B></LI> - -<LI> -<B>put_all </B>specifies DB_LOCK_PUT_ALL to release all locks held by <B><I>locker</I></B>. -Requires a tuple <B>{put_all}</B></LI> - -<LI> -<B>put_obj</B> specifies DB_LOCK_PUT_OBJ to release all locks held by <B><I>locker</I></B> -associated with the given <B><I>obj</I></B>. Requires a tuple <B>{put_obj -<I>obj</I>}</B></LI> -</UL> -</UL> +mode, lock handle} where what is required is based on the operation desired:</li> + +<ul> +<li> +<b>get</b> specifes DB_LOCK_GET to get a lock. Requires a tuple <b>{get +<i>objmode</i>} +</b>where +<b><i>mode</i></b> +is:</li> + +<ul> +<li> +<b>ng </b>specifies DB_LOCK_NG for not granted (always 0)</li> + +<li> +<b>read</b> specifies DB_LOCK_READ for a read (shared) lock</li> + +<li> +<b>write</b> specifies DB_LOCK_WRITE for an exclusive write lock</li> + +<li> +<b>iwrite </b>specifies DB_LOCK_IWRITE for intent for exclusive write lock</li> + +<li> +<b>iread </b>specifies DB_LOCK_IREAD for intent for shared read lock</li> + +<li> +<b>iwr </b>specifies DB_LOCK_IWR for intent for eread and write lock</li> +</ul> + +<li> +<b>put</b> specifies DB_LOCK_PUT to release a <b><i>lock</i></b>. +Requires a tuple <b>{put <i>lock}</i></b></li> + +<li> +<b>put_all </b>specifies DB_LOCK_PUT_ALL to release all locks held by <b><i>locker</i></b>. +Requires a tuple <b>{put_all}</b></li> + +<li> +<b>put_obj</b> specifies DB_LOCK_PUT_OBJ to release all locks held by <b><i>locker</i></b> +associated with the given <b><i>obj</i></b>. Requires a tuple <b>{put_obj +<i>obj}</i></b></li> +</ul> +</ul> + +<hr WIDTH="100%"> +<br><a NAME="> <env> lock_vec"></a><b>> <env> lock_timeout <i>timeout</i></b> +<p>This command sets the lock timeout for all future locks in this environment. +The timeout is in micorseconds. +<br> +<br> +</body> +</html> diff --git a/bdb/tcl/docs/log.html b/bdb/tcl/docs/log.html index 35ecfc2f5f5..49f2f0ad2e0 100644 --- a/bdb/tcl/docs/log.html +++ b/bdb/tcl/docs/log.html @@ -1,4 +1,5 @@ -<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> +<!--Copyright 1999-2002 by Sleepycat Software, Inc.--> +<!--All rights reserved.--> <HTML> <HEAD> <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso-8859-1"> @@ -100,7 +101,7 @@ given <B><I>lsn</I></B></LI> <HR WIDTH="100%"> <BR><A NAME="> <env> log_put"></A><B>> <env> log_put<I> </I>[-checkpoint] -[-curlsn] [-flush] <I>record</I></B> +[-flush] <I>record</I></B> <P>This command stores a <B><I>record</I></B> into the log and returns the LSN of the log record. It is a direct call to the <A HREF="../../docs/api_c/log_put.html">log_put</A> function. It returns either an LSN or it throws a Tcl error with @@ -110,29 +111,10 @@ a system message. <B> </B>The arguments are: <B>-checkpoint </B>selects the DB_CHECKPOINT flag</LI> <LI> -<B>-curlsn</B> selects the DB_CURLSN flag to return the LSN of the next -record</LI> - -<LI> <B>-flush </B>selects the DB_FLUSH flag to flush the log to disk.</LI> </UL> <HR WIDTH="100%"> -<BR><A NAME="> <env> log_register"></A><B>> <env> log_register <I>db</I> -<I>file</I></B> -<P>This command registers a <B><I>file</I></B> and <B><I>db</I></B> with -the log manager. It is a direct call to the <A HREF="../../docs/api_c/log_register.html">log_register</A> -function. It returns either a 0 (for success), a DB error message -or it throws a Tcl error with a system message. -<BR> -<HR WIDTH="100%"> -<BR><A NAME="> <env> log_unregister"></A><B>> <env> log_unregister <I>db</I></B> -<P>This command unregisters the file specified by the database handle <B><I>db -</I></B>from the log manager. It is a direct call to the <A HREF="../../docs/api_c/log_unregister.html">log_unregister</A> -function. It returns either a 0 (for success), a DB error message -or it throws a Tcl error with a system message. -<BR> -<HR WIDTH="100%"> <BR><B>> <env> log_stat</B> <P>This command returns the statistics associated with the logging subsystem. It is a direct call to the <A HREF="../../docs/api_c/log_stat.html">log_stat</A> diff --git a/bdb/tcl/docs/mpool.html b/bdb/tcl/docs/mpool.html index 666219306ca..7f2359b36e9 100644 --- a/bdb/tcl/docs/mpool.html +++ b/bdb/tcl/docs/mpool.html @@ -1,4 +1,5 @@ -<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> +<!--Copyright 1999-2002 by Sleepycat Software, Inc.--> +<!--All rights reserved.--> <HTML> <HEAD> <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso-8859-1"> diff --git a/bdb/tcl/docs/rep.html b/bdb/tcl/docs/rep.html new file mode 100644 index 00000000000..079fe443a63 --- /dev/null +++ b/bdb/tcl/docs/rep.html @@ -0,0 +1,51 @@ +<!--Copyright 1999-2002 by Sleepycat Software, Inc.--> +<!--All rights reserved.--> +<html> +<head> + <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1"> + <title>Replication commands</title> +</head> +<body> + +<h2> +<a NAME="Replication Commands"></a>Replication Commands</h2> +Replication commands are invoked from the environment handle, after +it has been opened with the appropriate flags defined +<a href="./env.html">here</a>.<br> +<hr WIDTH="100%"> +<p><b>> <env> rep_process_message <i>machid</i> <i>control</i> +<i>rec</i></b> +<p>This command processes a single incoming replication message. It +is a direct translation of the <a +href="../../docs/api_c/rep_process_message.html">rep_process_message</a> +function. +It returns either a 0 (for success), a DB error message or it throws a +Tcl error with a system message. The arguments are: +<ul> +<li> +<b>machid </b>is the machine ID of the machine that <i>sent</i> this +message.</li> + +<li> +<b>control</b> is a binary string containing the exact contents of the +<b><i>control</i></b> argument to the <b><i>sendproc</i></b> function +that was passed this message on another site.</li> + +<li> +<b>rec</b> is a binary string containing the exact contents of the +<b><i>rec</i></b> argument to the <b><i>sendproc</i></b> function +that was passed this message on another site.</li> +</ul> + +<hr WIDTH="100%"> +<br><b>> <env> rep_elect <i>nsites</i> <i>pri</i> <i>wait</i> +<i>sleep</i></b> +<p>This command causes a replication election. It is a direct translation +of the <a href="../../docs/api_c/rep_elect.html">rep_elect</a> function. +Its arguments, all integers, correspond exactly to that C function's +parameters. +It will return a list containing two integers, which contain, +respectively, the integer values returned in the C function's +<i><b>midp</b></i> and <i><b>selfp</b></i> parameters. +</body> +</html> diff --git a/bdb/tcl/docs/test.html b/bdb/tcl/docs/test.html index 10cf09efba7..603ae56a51e 100644 --- a/bdb/tcl/docs/test.html +++ b/bdb/tcl/docs/test.html @@ -1,4 +1,5 @@ -<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> +<!--Copyright 1999-2002 by Sleepycat Software, Inc.--> +<!--All rights reserved.--> <HTML> <HEAD> <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso-8859-1"> diff --git a/bdb/tcl/docs/txn.html b/bdb/tcl/docs/txn.html index 863c9a875e6..07c88c0fe1d 100644 --- a/bdb/tcl/docs/txn.html +++ b/bdb/tcl/docs/txn.html @@ -1,56 +1,67 @@ -<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> -<HTML> -<HEAD> - <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso-8859-1"> - <META NAME="GENERATOR" CONTENT="Mozilla/4.08 [en] (X11; I; FreeBSD 2.2.8-19990120-SNAP i386) [Netscape]"> -</HEAD> -<BODY> +<!--Copyright 1999-2002 by Sleepycat Software, Inc.--> +<!--All rights reserved.--> +<html> +<head> + <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1"> + <meta name="GENERATOR" content="Mozilla/4.75 [en] (X11; U; Linux 2.2.16-22 i686) [Netscape]"> +</head> +<body> -<H2> -<A NAME="Transaction Commands"></A>Transaction Commands</H2> +<h2> +<a NAME="Transaction Commands"></a>Transaction Commands</h2> Transactions are used in a manner similar to the other subsystems. We create a handle to the transaction and then use it for a variety of operations. Some of the transaction commands use the environment instead. Those are presented first. The transaction command handle returned is the handle used by the various commands that can be -transaction protected, such as <A HREF="../../docs/api_tcl/db_cursor.html">cursors</A>.<BR> - -<HR WIDTH="100%"> -<P><B>> <env> txn_checkpoint [-kbyte <I>kb</I>] [-min <I>min</I>]</B> -<P>This command causes a checkpoint of the transaction region. It -is a direct translation of the <A HREF="../../docs/api_c/txn_checkpoint.html">txn_checkpoint -</A>function. +transaction protected, such as <a href="../../docs/api_tcl/db_cursor.html">cursors</a>. +<br> +<hr WIDTH="100%"> +<p><b>> <env> txn_checkpoint [-kbyte <i>kb</i>] [-min <i>min</i>]</b> +<p>This command causes a checkpoint of the transaction region. It +is a direct translation of the <a href="../../docs/api_c/txn_checkpoint.html">txn_checkpoint +</a>function. It returns either a 0 (for success), a DB error message or it throws a Tcl error with a system message. The arguments are: -<UL> -<LI> -<B>-kbyte </B>causes the checkpoint to occur only if <B><I>kb</I></B> kilobytes -of log data has been written since the last checkpoint</LI> +<ul> +<li> +<b>-kbyte </b>causes the checkpoint to occur only if <b><i>kb</i></b> kilobytes +of log data has been written since the last checkpoint</li> -<LI> -<B>-min</B> causes the checkpoint to occur only if <B><I>min</I></B> minutes -have passed since the last checkpoint</LI> -</UL> +<li> +<b>-min</b> causes the checkpoint to occur only if <b><i>min</i></b> minutes +have passed since the last checkpoint</li> +</ul> -<HR WIDTH="100%"> -<BR><B>> <env> txn_stat</B> -<P>This command returns transaction statistics. It is a direct translation -of the <A HREF="../../docs/api_c/txn_stat.html">txn_stat</A> function. +<hr WIDTH="100%"> +<br><b>> <env> txn_stat</b> +<p>This command returns transaction statistics. It is a direct translation +of the <a href="../../docs/api_c/txn_stat.html">txn_stat</a> function. It will return a list of name/value pairs that correspond to the DB_TXN_STAT structure. -<HR WIDTH="100%"> -<BR><B>> <txn> id</B> -<P>This command returns the transaction id. It is a direct call to -the <A HREF="../../docs/api_c/txn_id.html">txn_id</A> function. The -typical use of this identifier is as the <B><I>locker</I></B> value for -the <A HREF="lock.html">lock_get</A> and <A HREF="lock.html">lock_vec</A> +<hr WIDTH="100%"> +<br><b>> <env> txn_id_set </b><i> current max</i> +<p>This is a diagnosic command that sets the next transaction id to be +allocated and the maximum transaction +<br>id, which is the point at which the relcaimation algorthm is triggered. +<hr WIDTH="100%"> +<br><b>> <txn> id</b> +<p>This command returns the transaction id. It is a direct call to +the <a href="../../docs/api_c/txn_id.html">txn_id</a> function. The +typical use of this identifier is as the <b><i>locker</i></b> value for +the <a href="lock.html">lock_get</a> and <a href="lock.html">lock_vec</a> calls. -<HR WIDTH="100%"> -<BR><B>> <txn> prepare</B> -<P>This command initiates a two-phase commit. It is a direct call -to the <A HREF="../../docs/api_c/txn_prepare.html">txn_prepare</A> function. +<hr WIDTH="100%"> +<br><b>> <txn> prepare</b> +<p>This command initiates a two-phase commit. It is a direct call +to the <a href="../../docs/api_c/txn_prepare.html">txn_prepare</a> function. It returns either a 0 (for success), a DB error message or it throws a Tcl error with a system message. -<HR WIDTH="100%"> -</BODY> -</HTML> +<hr WIDTH="100%"><a NAME="> <env> lock_vec"></a><b>> <env> txn_timeout +<i>timeout</i></b> +<p>This command sets thetransaction timeout for transactions started in +the future in this environment. The timeout is in micorseconds. +<br> +<br> +</body> +</html> diff --git a/bdb/tcl/tcl_compat.c b/bdb/tcl/tcl_compat.c index 41caee95cc7..e77bc32aedf 100644 --- a/bdb/tcl/tcl_compat.c +++ b/bdb/tcl/tcl_compat.c @@ -1,16 +1,18 @@ /*- * See the file LICENSE for redistribution information. * - * Copyright (c) 1999, 2000 + * Copyright (c) 1999-2001 * Sleepycat Software. All rights reserved. */ #include "db_config.h" #ifndef lint -static const char revid[] = "$Id: tcl_compat.c,v 11.22 2001/01/11 18:19:55 bostic Exp $"; +static const char revid[] = "$Id: tcl_compat.c,v 11.39 2002/08/15 14:05:38 bostic Exp $"; #endif /* not lint */ +#if CONFIG_TEST + #ifndef NO_SYSTEM_INCLUDES #include <sys/types.h> @@ -23,12 +25,7 @@ static const char revid[] = "$Id: tcl_compat.c,v 11.22 2001/01/11 18:19:55 bosti #define DB_DBM_HSEARCH 1 #include "db_int.h" -#include "tcl_db.h" - -/* - * Prototypes for procedures defined later in this file: - */ -static int mutex_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*)); +#include "dbinc/tcl_db.h" /* * bdb_HCommand -- @@ -91,7 +88,7 @@ bdb_HCommand(interp, objc, objv) if (result == TCL_OK) { _debug_check(); ret = hcreate(nelem) == 0 ? 1: 0; - _ReturnSetup(interp, ret, "hcreate"); + _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "hcreate"); } break; case HHSEARCH: @@ -104,17 +101,17 @@ bdb_HCommand(interp, objc, objv) } item.key = Tcl_GetStringFromObj(objv[2], NULL); item.data = Tcl_GetStringFromObj(objv[3], NULL); - action = 0; if (Tcl_GetIndexFromObj(interp, objv[4], srchacts, "action", TCL_EXACT, &actindex) != TCL_OK) return (IS_HELP(objv[4])); switch ((enum srchacts)actindex) { - case ACT_FIND: - action = FIND; - break; case ACT_ENTER: action = ENTER; break; + default: + case ACT_FIND: + action = FIND; + break; } _debug_check(); hres = hsearch(item, action); @@ -182,7 +179,7 @@ bdb_NdbmOpen(interp, objc, objv, dbpp) }; u_int32_t open_flags; - int endarg, i, mode, optindex, read_only, result; + int endarg, i, mode, optindex, read_only, result, ret; char *arg, *db; result = TCL_OK; @@ -281,7 +278,9 @@ bdb_NdbmOpen(interp, objc, objv, dbpp) open_flags |= O_RDWR; _debug_check(); if ((*dbpp = dbm_open(db, open_flags, mode)) == NULL) { - result = _ReturnSetup(interp, Tcl_GetErrno(), "db open"); + ret = Tcl_GetErrno(); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "db open"); goto error; } return (TCL_OK); @@ -335,10 +334,13 @@ bdb_DbmCommand(interp, objc, objv, flag, dbm) STINSERT, STREPLACE }; datum key, data; - int cmdindex, stindex, result, ret; + void *dtmp, *ktmp; + u_int32_t size; + int cmdindex, freedata, freekey, stindex, result, ret; char *name, *t; result = TCL_OK; + freekey = freedata = 0; /* * Get the command name index from the object based on the cmds * defined above. This SHOULD NOT fail because we already checked @@ -365,7 +367,7 @@ bdb_DbmCommand(interp, objc, objv, flag, dbm) "Bad interface flag for command", TCL_STATIC); return (TCL_ERROR); } - _ReturnSetup(interp, ret, "dbmclose"); + _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "dbmclose"); break; case DBMINIT: /* @@ -383,7 +385,7 @@ bdb_DbmCommand(interp, objc, objv, flag, dbm) TCL_STATIC); return (TCL_ERROR); } - _ReturnSetup(interp, ret, "dbminit"); + _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "dbminit"); break; case DBMFETCH: /* @@ -393,7 +395,14 @@ bdb_DbmCommand(interp, objc, objv, flag, dbm) Tcl_WrongNumArgs(interp, 2, objv, "key"); return (TCL_ERROR); } - key.dptr = (char *)Tcl_GetByteArrayFromObj(objv[2], &key.dsize); + if ((ret = _CopyObjBytes( + interp, objv[2], &ktmp, &size, &freekey)) != 0) { + result = _ReturnSetup(interp, ret, + DB_RETOK_STD(ret), "dbm fetch"); + goto out; + } + key.dsize = size; + key.dptr = (char *)ktmp; _debug_check(); if (flag == DBTCL_DBM) data = fetch(key); @@ -402,16 +411,17 @@ bdb_DbmCommand(interp, objc, objv, flag, dbm) else { Tcl_SetResult(interp, "Bad interface flag for command", TCL_STATIC); - return (TCL_ERROR); + result = TCL_ERROR; + goto out; } if (data.dptr == NULL || - (ret = __os_malloc(NULL, data.dsize + 1, NULL, &t)) != 0) + (ret = __os_malloc(NULL, data.dsize + 1, &t)) != 0) Tcl_SetResult(interp, "-1", TCL_STATIC); else { memcpy(t, data.dptr, data.dsize); t[data.dsize] = '\0'; Tcl_SetResult(interp, t, TCL_VOLATILE); - __os_free(t, data.dsize + 1); + __os_free(NULL, t); } break; case DBMSTORE: @@ -426,9 +436,22 @@ bdb_DbmCommand(interp, objc, objv, flag, dbm) Tcl_WrongNumArgs(interp, 2, objv, "key data action"); return (TCL_ERROR); } - key.dptr = (char *)Tcl_GetByteArrayFromObj(objv[2], &key.dsize); - data.dptr = - (char *)Tcl_GetByteArrayFromObj(objv[3], &data.dsize); + if ((ret = _CopyObjBytes( + interp, objv[2], &ktmp, &size, &freekey)) != 0) { + result = _ReturnSetup(interp, ret, + DB_RETOK_STD(ret), "dbm fetch"); + goto out; + } + key.dsize = size; + key.dptr = (char *)ktmp; + if ((ret = _CopyObjBytes( + interp, objv[3], &dtmp, &size, &freedata)) != 0) { + result = _ReturnSetup(interp, ret, + DB_RETOK_STD(ret), "dbm fetch"); + goto out; + } + data.dsize = size; + data.dptr = (char *)dtmp; _debug_check(); if (flag == DBTCL_DBM) ret = store(key, data); @@ -450,7 +473,7 @@ bdb_DbmCommand(interp, objc, objv, flag, dbm) "Bad interface flag for command", TCL_STATIC); return (TCL_ERROR); } - _ReturnSetup(interp, ret, "store"); + _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "store"); break; case DBMDELETE: /* @@ -460,7 +483,14 @@ bdb_DbmCommand(interp, objc, objv, flag, dbm) Tcl_WrongNumArgs(interp, 2, objv, "key"); return (TCL_ERROR); } - key.dptr = (char *)Tcl_GetByteArrayFromObj(objv[2], &key.dsize); + if ((ret = _CopyObjBytes( + interp, objv[2], &ktmp, &size, &freekey)) != 0) { + result = _ReturnSetup(interp, ret, + DB_RETOK_STD(ret), "dbm fetch"); + goto out; + } + key.dsize = size; + key.dptr = (char *)ktmp; _debug_check(); if (flag == DBTCL_DBM) ret = delete(key); @@ -471,7 +501,7 @@ bdb_DbmCommand(interp, objc, objv, flag, dbm) "Bad interface flag for command", TCL_STATIC); return (TCL_ERROR); } - _ReturnSetup(interp, ret, "delete"); + _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "delete"); break; case DBMFIRST: /* @@ -492,13 +522,13 @@ bdb_DbmCommand(interp, objc, objv, flag, dbm) return (TCL_ERROR); } if (key.dptr == NULL || - (ret = __os_malloc(NULL, key.dsize + 1, NULL, &t)) != 0) + (ret = __os_malloc(NULL, key.dsize + 1, &t)) != 0) Tcl_SetResult(interp, "-1", TCL_STATIC); else { memcpy(t, key.dptr, key.dsize); t[key.dsize] = '\0'; Tcl_SetResult(interp, t, TCL_VOLATILE); - __os_free(t, key.dsize + 1); + __os_free(NULL, t); } break; case DBMNEXT: @@ -511,8 +541,14 @@ bdb_DbmCommand(interp, objc, objv, flag, dbm) Tcl_WrongNumArgs(interp, 2, objv, NULL); return (TCL_ERROR); } - key.dptr = (char *) - Tcl_GetByteArrayFromObj(objv[2], &key.dsize); + if ((ret = _CopyObjBytes( + interp, objv[2], &ktmp, &size, &freekey)) != 0) { + result = _ReturnSetup(interp, ret, + DB_RETOK_STD(ret), "dbm fetch"); + goto out; + } + key.dsize = size; + key.dptr = (char *)ktmp; data = nextkey(key); } else if (flag == DBTCL_NDBM) { if (objc != 2) { @@ -526,16 +562,21 @@ bdb_DbmCommand(interp, objc, objv, flag, dbm) return (TCL_ERROR); } if (data.dptr == NULL || - (ret = __os_malloc(NULL, data.dsize + 1, NULL, &t)) != 0) + (ret = __os_malloc(NULL, data.dsize + 1, &t)) != 0) Tcl_SetResult(interp, "-1", TCL_STATIC); else { memcpy(t, data.dptr, data.dsize); t[data.dsize] = '\0'; Tcl_SetResult(interp, t, TCL_VOLATILE); - __os_free(t, data.dsize + 1); + __os_free(NULL, t); } break; } +out: + if (freedata) + (void)__os_free(NULL, dtmp); + if (freekey) + (void)__os_free(NULL, ktmp); return (result); } @@ -636,7 +677,8 @@ ndbm_Cmd(clientData, interp, objc, objv) _debug_check(); ret = dbm_clearerr(dbp); if (ret) - _ReturnSetup(interp, ret, "clearerr"); + _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "clearerr"); else res = Tcl_NewIntObj(ret); break; @@ -688,7 +730,7 @@ ndbm_Cmd(clientData, interp, objc, objv) _debug_check(); ret = dbm_rdonly(dbp); if (ret) - _ReturnSetup(interp, ret, "rdonly"); + _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "rdonly"); else res = Tcl_NewIntObj(ret); break; @@ -701,355 +743,4 @@ ndbm_Cmd(clientData, interp, objc, objv) Tcl_SetObjResult(interp, res); return (result); } - -/* - * bdb_RandCommand -- - * Implements rand* functions. - * - * PUBLIC: int bdb_RandCommand __P((Tcl_Interp *, int, Tcl_Obj * CONST*)); - */ -int -bdb_RandCommand(interp, objc, objv) - Tcl_Interp *interp; /* Interpreter */ - int objc; /* How many arguments? */ - Tcl_Obj *CONST objv[]; /* The argument objects */ -{ - static char *rcmds[] = { - "rand", "random_int", "srand", - NULL - }; - enum rcmds { - RRAND, RRAND_INT, RSRAND - }; - long t; - int cmdindex, hi, lo, result, ret; - Tcl_Obj *res; - char msg[MSG_SIZE]; - - result = TCL_OK; - /* - * Get the command name index from the object based on the cmds - * defined above. This SHOULD NOT fail because we already checked - * in the 'berkdb' command. - */ - if (Tcl_GetIndexFromObj(interp, - objv[1], rcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK) - return (IS_HELP(objv[1])); - - res = NULL; - switch ((enum rcmds)cmdindex) { - case RRAND: - /* - * Must be 0 args. Error if different. - */ - if (objc != 2) { - Tcl_WrongNumArgs(interp, 2, objv, NULL); - return (TCL_ERROR); - } - ret = rand(); - res = Tcl_NewIntObj(ret); - break; - case RRAND_INT: - /* - * Must be 4 args. Error if different. - */ - if (objc != 4) { - Tcl_WrongNumArgs(interp, 2, objv, "lo hi"); - return (TCL_ERROR); - } - result = Tcl_GetIntFromObj(interp, objv[2], &lo); - if (result != TCL_OK) - break; - result = Tcl_GetIntFromObj(interp, objv[3], &hi); - if (result == TCL_OK) { -#ifndef RAND_MAX -#define RAND_MAX 0x7fffffff -#endif - t = rand(); - if (t > RAND_MAX) { - snprintf(msg, MSG_SIZE, - "Max random is higher than %ld\n", - (long)RAND_MAX); - Tcl_SetResult(interp, msg, TCL_VOLATILE); - result = TCL_ERROR; - break; - } - _debug_check(); - ret = (int)(((double)t / ((double)(RAND_MAX) + 1)) * - (hi - lo + 1)); - ret += lo; - res = Tcl_NewIntObj(ret); - } - break; - case RSRAND: - /* - * Must be 1 arg. Error if different. - */ - if (objc != 3) { - Tcl_WrongNumArgs(interp, 2, objv, "seed"); - return (TCL_ERROR); - } - result = Tcl_GetIntFromObj(interp, objv[2], &lo); - if (result == TCL_OK) { - srand((u_int)lo); - res = Tcl_NewIntObj(0); - } - break; - } - /* - * Only set result if we have a res. Otherwise, lower - * functions have already done so. - */ - if (result == TCL_OK && res) - Tcl_SetObjResult(interp, res); - return (result); -} - -/* - * - * tcl_Mutex -- - * Opens an env mutex. - * - * PUBLIC: int tcl_Mutex __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *, - * PUBLIC: DBTCL_INFO *)); - */ -int -tcl_Mutex(interp, objc, objv, envp, envip) - Tcl_Interp *interp; /* Interpreter */ - int objc; /* How many arguments? */ - Tcl_Obj *CONST objv[]; /* The argument objects */ - DB_ENV *envp; /* Environment pointer */ - DBTCL_INFO *envip; /* Info pointer */ -{ - DBTCL_INFO *ip; - Tcl_Obj *res; - _MUTEX_DATA *md; - int i, mode, nitems, result, ret; - char newname[MSG_SIZE]; - - md = NULL; - result = TCL_OK; - mode = nitems = ret = 0; - memset(newname, 0, MSG_SIZE); - - if (objc != 4) { - Tcl_WrongNumArgs(interp, 2, objv, "mode nitems"); - return (TCL_ERROR); - } - result = Tcl_GetIntFromObj(interp, objv[2], &mode); - if (result != TCL_OK) - return (TCL_ERROR); - result = Tcl_GetIntFromObj(interp, objv[3], &nitems); - if (result != TCL_OK) - return (TCL_ERROR); - - snprintf(newname, sizeof(newname), - "%s.mutex%d", envip->i_name, envip->i_envmutexid); - ip = _NewInfo(interp, NULL, newname, I_MUTEX); - if (ip == NULL) { - Tcl_SetResult(interp, "Could not set up info", - TCL_STATIC); - return (TCL_ERROR); - } - /* - * Set up mutex. - */ - /* - * Map in the region. - * - * XXX - * We don't bother doing this "right", i.e., using the shalloc - * functions, just grab some memory knowing that it's correctly - * aligned. - */ - _debug_check(); - if (__os_calloc(NULL, 1, sizeof(_MUTEX_DATA), &md) != 0) - goto posixout; - md->env = envp; - md->n_mutex = nitems; - md->size = sizeof(_MUTEX_ENTRY) * nitems; - - md->reginfo.type = REGION_TYPE_MUTEX; - md->reginfo.id = INVALID_REGION_TYPE; - md->reginfo.mode = mode; - md->reginfo.flags = REGION_CREATE_OK | REGION_JOIN_OK; - if ((ret = __db_r_attach(envp, &md->reginfo, md->size)) != 0) - goto posixout; - md->marray = md->reginfo.addr; - - /* Initialize a created region. */ - if (F_ISSET(&md->reginfo, REGION_CREATE)) - for (i = 0; i < nitems; i++) { - md->marray[i].val = 0; - if ((ret = - __db_mutex_init(envp, &md->marray[i].m, i, 0)) != 0) - goto posixout; - } - R_UNLOCK(envp, &md->reginfo); - - /* - * Success. Set up return. Set up new info - * and command widget for this mutex. - */ - envip->i_envmutexid++; - ip->i_parent = envip; - _SetInfoData(ip, md); - Tcl_CreateObjCommand(interp, newname, - (Tcl_ObjCmdProc *)mutex_Cmd, (ClientData)md, NULL); - res = Tcl_NewStringObj(newname, strlen(newname)); - Tcl_SetObjResult(interp, res); - - return (TCL_OK); - -posixout: - if (ret > 0) - Tcl_PosixError(interp); - result = _ReturnSetup(interp, ret, "mutex"); - _DeleteInfo(ip); - - if (md != NULL) { - if (md->reginfo.addr != NULL) - (void)__db_r_detach(md->env, - &md->reginfo, F_ISSET(&md->reginfo, REGION_CREATE)); - __os_free(md, sizeof(*md)); - } - return (result); -} - -/* - * mutex_Cmd -- - * Implements the "mutex" widget. - */ -static int -mutex_Cmd(clientData, interp, objc, objv) - ClientData clientData; /* Mutex handle */ - Tcl_Interp *interp; /* Interpreter */ - int objc; /* How many arguments? */ - Tcl_Obj *CONST objv[]; /* The argument objects */ -{ - static char *mxcmds[] = { - "close", - "get", - "getval", - "release", - "setval", - NULL - }; - enum mxcmds { - MXCLOSE, - MXGET, - MXGETVAL, - MXRELE, - MXSETVAL - }; - DB_ENV *dbenv; - DBTCL_INFO *envip, *mpip; - _MUTEX_DATA *mp; - Tcl_Obj *res; - int cmdindex, id, result, newval; - - Tcl_ResetResult(interp); - mp = (_MUTEX_DATA *)clientData; - mpip = _PtrToInfo((void *)mp); - envip = mpip->i_parent; - dbenv = envip->i_envp; - result = TCL_OK; - - if (mp == NULL) { - Tcl_SetResult(interp, "NULL mp pointer", TCL_STATIC); - return (TCL_ERROR); - } - if (mpip == NULL) { - Tcl_SetResult(interp, "NULL mp info pointer", TCL_STATIC); - return (TCL_ERROR); - } - - /* - * Get the command name index from the object based on the dbcmds - * defined above. - */ - if (Tcl_GetIndexFromObj(interp, - objv[1], mxcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK) - return (IS_HELP(objv[1])); - - res = NULL; - switch ((enum mxcmds)cmdindex) { - case MXCLOSE: - if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, NULL); - return (TCL_ERROR); - } - _debug_check(); - (void)__db_r_detach(mp->env, &mp->reginfo, 0); - res = Tcl_NewIntObj(0); - (void)Tcl_DeleteCommand(interp, mpip->i_name); - _DeleteInfo(mpip); - __os_free(mp, sizeof(*mp)); - break; - case MXRELE: - /* - * Check for 1 arg. Error if different. - */ - if (objc != 3) { - Tcl_WrongNumArgs(interp, 2, objv, "id"); - return (TCL_ERROR); - } - result = Tcl_GetIntFromObj(interp, objv[2], &id); - if (result != TCL_OK) - break; - MUTEX_UNLOCK(dbenv, &mp->marray[id].m); - res = Tcl_NewIntObj(0); - break; - case MXGET: - /* - * Check for 1 arg. Error if different. - */ - if (objc != 3) { - Tcl_WrongNumArgs(interp, 2, objv, "id"); - return (TCL_ERROR); - } - result = Tcl_GetIntFromObj(interp, objv[2], &id); - if (result != TCL_OK) - break; - MUTEX_LOCK(dbenv, &mp->marray[id].m, mp->env->lockfhp); - res = Tcl_NewIntObj(0); - break; - case MXGETVAL: - /* - * Check for 1 arg. Error if different. - */ - if (objc != 3) { - Tcl_WrongNumArgs(interp, 2, objv, "id"); - return (TCL_ERROR); - } - result = Tcl_GetIntFromObj(interp, objv[2], &id); - if (result != TCL_OK) - break; - res = Tcl_NewIntObj(mp->marray[id].val); - break; - case MXSETVAL: - /* - * Check for 2 args. Error if different. - */ - if (objc != 4) { - Tcl_WrongNumArgs(interp, 2, objv, "id val"); - return (TCL_ERROR); - } - result = Tcl_GetIntFromObj(interp, objv[2], &id); - if (result != TCL_OK) - break; - result = Tcl_GetIntFromObj(interp, objv[3], &newval); - if (result != TCL_OK) - break; - mp->marray[id].val = newval; - res = Tcl_NewIntObj(0); - break; - } - /* - * Only set result if we have a res. Otherwise, lower - * functions have already done so. - */ - if (result == TCL_OK && res) - Tcl_SetObjResult(interp, res); - return (result); -} +#endif /* CONFIG_TEST */ diff --git a/bdb/tcl/tcl_db.c b/bdb/tcl/tcl_db.c index 8e7215a272a..7df2e48311c 100644 --- a/bdb/tcl/tcl_db.c +++ b/bdb/tcl/tcl_db.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.c,v 11.55 2000/11/28 20:12:31 bostic Exp $"; +static const char revid[] = "$Id: tcl_db.c,v 11.107 2002/08/06 06:20:31 bostic Exp $"; #endif /* not lint */ #ifndef NO_SYSTEM_INCLUDES @@ -20,24 +20,61 @@ static const char revid[] = "$Id: tcl_db.c,v 11.55 2000/11/28 20:12:31 bostic Ex #endif #include "db_int.h" -#include "tcl_db.h" +#include "dbinc/db_page.h" +#include "dbinc/db_am.h" +#include "dbinc/tcl_db.h" /* * Prototypes for procedures defined later in this file: */ +static int tcl_DbAssociate __P((Tcl_Interp *, + int, Tcl_Obj * CONST*, DB *)); static int tcl_DbClose __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *, DBTCL_INFO *)); static int tcl_DbDelete __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *)); -static int tcl_DbGet __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *)); +static int tcl_DbGet __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *, int)); static int tcl_DbKeyRange __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *)); static int tcl_DbPut __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *)); static int tcl_DbStat __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *)); +static int tcl_DbTruncate __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *)); static int tcl_DbCursor __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *, DBC **)); static int tcl_DbJoin __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *, DBC **)); static int tcl_DbGetjoin __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *)); static int tcl_DbCount __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *)); +static int tcl_second_call __P((DB *, const DBT *, const DBT *, DBT *)); + +/* + * _DbInfoDelete -- + * + * PUBLIC: void _DbInfoDelete __P((Tcl_Interp *, DBTCL_INFO *)); + */ +void +_DbInfoDelete(interp, dbip) + Tcl_Interp *interp; + DBTCL_INFO *dbip; +{ + DBTCL_INFO *nextp, *p; + /* + * First we have to close any open cursors. Then we close + * our db. + */ + for (p = LIST_FIRST(&__db_infohead); p != NULL; p = nextp) { + nextp = LIST_NEXT(p, entries); + /* + * Check if this is a cursor info structure and if + * it is, if it belongs to this DB. If so, remove + * its commands and info structure. + */ + if (p->i_parent == dbip && p->i_type == I_DBC) { + (void)Tcl_DeleteCommand(interp, p->i_name); + _DeleteInfo(p); + } + } + (void)Tcl_DeleteCommand(interp, dbip->i_name); + _DeleteInfo(dbip); +} /* * @@ -54,6 +91,13 @@ db_Cmd(clientData, interp, objc, objv) Tcl_Obj *CONST objv[]; /* The argument objects */ { static char *dbcmds[] = { +#if CONFIG_TEST + "keyrange", + "pget", + "rpcid", + "test", +#endif + "associate", "close", "count", "cursor", @@ -63,16 +107,20 @@ db_Cmd(clientData, interp, objc, objv) "get_type", "is_byteswapped", "join", - "keyrange", "put", "stat", "sync", -#if CONFIG_TEST - "test", -#endif + "truncate", NULL }; enum dbcmds { +#if CONFIG_TEST + DBKEYRANGE, + DBPGET, + DBRPCID, + DBTEST, +#endif + DBASSOCIATE, DBCLOSE, DBCOUNT, DBCURSOR, @@ -82,20 +130,18 @@ db_Cmd(clientData, interp, objc, objv) DBGETTYPE, DBSWAPPED, DBJOIN, - DBKEYRANGE, DBPUT, DBSTAT, - DBSYNC -#if CONFIG_TEST - , DBTEST -#endif + DBSYNC, + DBTRUNCATE }; DB *dbp; DBC *dbc; DBTCL_INFO *dbip; DBTCL_INFO *ip; + DBTYPE type; Tcl_Obj *res; - int cmdindex, result, ret; + int cmdindex, isswapped, result, ret; char newname[MSG_SIZE]; Tcl_ResetResult(interp); @@ -126,6 +172,34 @@ db_Cmd(clientData, interp, objc, objv) res = NULL; switch ((enum dbcmds)cmdindex) { +#if CONFIG_TEST + case DBKEYRANGE: + result = tcl_DbKeyRange(interp, objc, objv, dbp); + break; + case DBPGET: + result = tcl_DbGet(interp, objc, objv, dbp, 1); + break; + case DBRPCID: + /* + * No args for this. Error if there are some. + */ + if (objc > 2) { + Tcl_WrongNumArgs(interp, 2, objv, NULL); + return (TCL_ERROR); + } + /* + * !!! Retrieve the client ID from the dbp handle directly. + * This is for testing purposes only. It is dbp-private data. + */ + res = Tcl_NewLongObj(dbp->cl_id); + break; + case DBTEST: + result = tcl_EnvTest(interp, objc, objv, dbp->dbenv); + break; +#endif + case DBASSOCIATE: + result = tcl_DbAssociate(interp, objc, objv, dbp); + break; case DBCLOSE: result = tcl_DbClose(interp, objc, objv, dbp, dbip); break; @@ -133,10 +207,7 @@ db_Cmd(clientData, interp, objc, objv) result = tcl_DbDelete(interp, objc, objv, dbp); break; case DBGET: - result = tcl_DbGet(interp, objc, objv, dbp); - break; - case DBKEYRANGE: - result = tcl_DbKeyRange(interp, objc, objv, dbp); + result = tcl_DbGet(interp, objc, objv, dbp, 0); break; case DBPUT: result = tcl_DbPut(interp, objc, objv, dbp); @@ -153,8 +224,8 @@ db_Cmd(clientData, interp, objc, objv) return (TCL_ERROR); } _debug_check(); - ret = dbp->get_byteswapped(dbp); - res = Tcl_NewIntObj(ret); + ret = dbp->get_byteswapped(dbp, &isswapped); + res = Tcl_NewIntObj(isswapped); break; case DBGETTYPE: /* @@ -165,14 +236,14 @@ db_Cmd(clientData, interp, objc, objv) return (TCL_ERROR); } _debug_check(); - ret = dbp->get_type(dbp); - if (ret == DB_BTREE) + ret = dbp->get_type(dbp, &type); + if (type == DB_BTREE) res = Tcl_NewStringObj("btree", strlen("btree")); - else if (ret == DB_HASH) + else if (type == DB_HASH) res = Tcl_NewStringObj("hash", strlen("hash")); - else if (ret == DB_RECNO) + else if (type == DB_RECNO) res = Tcl_NewStringObj("recno", strlen("recno")); - else if (ret == DB_QUEUE) + else if (type == DB_QUEUE) res = Tcl_NewStringObj("queue", strlen("queue")); else { Tcl_SetResult(interp, @@ -248,11 +319,9 @@ db_Cmd(clientData, interp, objc, objv) case DBGETJOIN: result = tcl_DbGetjoin(interp, objc, objv, dbp); break; -#if CONFIG_TEST - case DBTEST: - result = tcl_EnvTest(interp, objc, objv, dbp->dbenv); + case DBTRUNCATE: + result = tcl_DbTruncate(interp, objc, objv, dbp); break; -#endif } /* * Only set result if we have a res. Otherwise, lower @@ -277,7 +346,7 @@ tcl_DbStat(interp, objc, objv, dbp) DB_HASH_STAT *hsp; DB_QUEUE_STAT *qsp; void *sp; - Tcl_Obj *res; + Tcl_Obj *res, *flaglist, *myobjv[2]; DBTYPE type; u_int32_t flag; int result, ret; @@ -287,16 +356,14 @@ tcl_DbStat(interp, objc, objv, dbp) flag = 0; if (objc > 3) { - Tcl_WrongNumArgs(interp, 2, objv, "?-recordcount?"); + Tcl_WrongNumArgs(interp, 2, objv, "?-faststat?"); return (TCL_ERROR); } if (objc == 3) { arg = Tcl_GetStringFromObj(objv[2], NULL); - if (strcmp(arg, "-recordcount") == 0) - flag = DB_RECORDCOUNT; - else if (strcmp(arg, "-cachedcounts") == 0) - flag = DB_CACHED_COUNTS; + if (strcmp(arg, "-faststat") == 0) + flag = DB_FAST_STAT; else { Tcl_SetResult(interp, "db stat: unknown arg", TCL_STATIC); @@ -305,17 +372,18 @@ tcl_DbStat(interp, objc, objv, dbp) } _debug_check(); - ret = dbp->stat(dbp, &sp, NULL, flag); - result = _ReturnSetup(interp, ret, "db stat"); + ret = dbp->stat(dbp, &sp, flag); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db stat"); if (result == TCL_ERROR) return (result); - type = dbp->get_type(dbp); + (void)dbp->get_type(dbp, &type); /* * Have our stats, now construct the name value * list pairs and free up the memory. */ res = Tcl_NewObj(); + /* * MAKE_STAT_LIST assumes 'res' and 'error' label. */ @@ -326,42 +394,48 @@ tcl_DbStat(interp, objc, objv, dbp) MAKE_STAT_LIST("Page size", hsp->hash_pagesize); MAKE_STAT_LIST("Number of keys", hsp->hash_nkeys); MAKE_STAT_LIST("Number of records", hsp->hash_ndata); - MAKE_STAT_LIST("Estim. number of elements", hsp->hash_nelem); MAKE_STAT_LIST("Fill factor", hsp->hash_ffactor); MAKE_STAT_LIST("Buckets", hsp->hash_buckets); - MAKE_STAT_LIST("Free pages", hsp->hash_free); - MAKE_STAT_LIST("Bytes free", hsp->hash_bfree); - MAKE_STAT_LIST("Number of big pages", hsp->hash_bigpages); - MAKE_STAT_LIST("Big pages bytes free", hsp->hash_big_bfree); - MAKE_STAT_LIST("Overflow pages", hsp->hash_overflows); - MAKE_STAT_LIST("Overflow bytes free", hsp->hash_ovfl_free); - MAKE_STAT_LIST("Duplicate pages", hsp->hash_dup); - MAKE_STAT_LIST("Duplicate pages bytes free", - hsp->hash_dup_free); + if (flag != DB_FAST_STAT) { + MAKE_STAT_LIST("Free pages", hsp->hash_free); + MAKE_STAT_LIST("Bytes free", hsp->hash_bfree); + MAKE_STAT_LIST("Number of big pages", + hsp->hash_bigpages); + MAKE_STAT_LIST("Big pages bytes free", + hsp->hash_big_bfree); + MAKE_STAT_LIST("Overflow pages", hsp->hash_overflows); + MAKE_STAT_LIST("Overflow bytes free", + hsp->hash_ovfl_free); + MAKE_STAT_LIST("Duplicate pages", hsp->hash_dup); + MAKE_STAT_LIST("Duplicate pages bytes free", + hsp->hash_dup_free); + } } else if (type == DB_QUEUE) { qsp = (DB_QUEUE_STAT *)sp; MAKE_STAT_LIST("Magic", qsp->qs_magic); MAKE_STAT_LIST("Version", qsp->qs_version); MAKE_STAT_LIST("Page size", qsp->qs_pagesize); - MAKE_STAT_LIST("Number of records", qsp->qs_ndata); - MAKE_STAT_LIST("Number of pages", qsp->qs_pages); - MAKE_STAT_LIST("Bytes free", qsp->qs_pgfree); + MAKE_STAT_LIST("Extent size", qsp->qs_extentsize); + MAKE_STAT_LIST("Number of records", qsp->qs_nkeys); MAKE_STAT_LIST("Record length", qsp->qs_re_len); MAKE_STAT_LIST("Record pad", qsp->qs_re_pad); MAKE_STAT_LIST("First record number", qsp->qs_first_recno); MAKE_STAT_LIST("Last record number", qsp->qs_cur_recno); + if (flag != DB_FAST_STAT) { + MAKE_STAT_LIST("Number of pages", qsp->qs_pages); + MAKE_STAT_LIST("Bytes free", qsp->qs_pgfree); + } } else { /* BTREE and RECNO are same stats */ bsp = (DB_BTREE_STAT *)sp; + MAKE_STAT_LIST("Magic", bsp->bt_magic); + MAKE_STAT_LIST("Version", bsp->bt_version); MAKE_STAT_LIST("Number of keys", bsp->bt_nkeys); MAKE_STAT_LIST("Number of records", bsp->bt_ndata); - if (flag != DB_RECORDCOUNT) { - MAKE_STAT_LIST("Magic", bsp->bt_magic); - MAKE_STAT_LIST("Version", bsp->bt_version); - MAKE_STAT_LIST("Flags", bsp->bt_metaflags); - MAKE_STAT_LIST("Minimum keys per page", bsp->bt_minkey); - MAKE_STAT_LIST("Fixed record length", bsp->bt_re_len); - MAKE_STAT_LIST("Record pad", bsp->bt_re_pad); - MAKE_STAT_LIST("Page size", bsp->bt_pagesize); + MAKE_STAT_LIST("Minimum keys per page", bsp->bt_minkey); + MAKE_STAT_LIST("Fixed record length", bsp->bt_re_len); + MAKE_STAT_LIST("Record pad", bsp->bt_re_pad); + MAKE_STAT_LIST("Page size", bsp->bt_pagesize); + if (flag != DB_FAST_STAT) { MAKE_STAT_LIST("Levels", bsp->bt_levels); MAKE_STAT_LIST("Internal pages", bsp->bt_int_pg); MAKE_STAT_LIST("Leaf pages", bsp->bt_leaf_pg); @@ -378,9 +452,27 @@ tcl_DbStat(interp, objc, objv, dbp) bsp->bt_over_pgfree); } } + + /* + * Construct a {name {flag1 flag2 ... flagN}} list for the + * dbp flags. These aren't access-method dependent, but they + * include all the interesting flags, and the integer value + * isn't useful from Tcl--return the strings instead. + */ + myobjv[0] = Tcl_NewStringObj("Flags", strlen("Flags")); + myobjv[1] = _GetFlagsList(interp, dbp->flags, __db_inmemdbflags); + flaglist = Tcl_NewListObj(2, myobjv); + if (flaglist == NULL) { + result = TCL_ERROR; + goto error; + } + if ((result = + Tcl_ListObjAppendElement(interp, res, flaglist)) != TCL_OK) + goto error; + Tcl_SetObjResult(interp, res); error: - __os_free(sp, 0); + free(sp); return (result); } @@ -395,50 +487,62 @@ tcl_DbClose(interp, objc, objv, dbp, dbip) DB *dbp; /* Database pointer */ DBTCL_INFO *dbip; /* Info pointer */ { - DBTCL_INFO *p, *nextp; + static char *dbclose[] = { + "-nosync", "--", NULL + }; + enum dbclose { + TCL_DBCLOSE_NOSYNC, + TCL_DBCLOSE_ENDARG + }; u_int32_t flag; - int result, ret; + int endarg, i, optindex, result, ret; char *arg; result = TCL_OK; + endarg = 0; flag = 0; - if (objc > 3) { + if (objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "?-nosync?"); return (TCL_ERROR); } - if (objc == 3) { - arg = Tcl_GetStringFromObj(objv[2], NULL); - if (strcmp(arg, "-nosync") == 0) + i = 2; + while (i < objc) { + if (Tcl_GetIndexFromObj(interp, objv[i], dbclose, + "option", TCL_EXACT, &optindex) != TCL_OK) { + arg = Tcl_GetStringFromObj(objv[i], NULL); + if (arg[0] == '-') + return (IS_HELP(objv[i])); + else + Tcl_ResetResult(interp); + break; + } + i++; + switch ((enum dbclose)optindex) { + case TCL_DBCLOSE_NOSYNC: flag = DB_NOSYNC; - else { - Tcl_SetResult(interp, - "dbclose: unknown arg", TCL_STATIC); - return (TCL_ERROR); + break; + case TCL_DBCLOSE_ENDARG: + endarg = 1; + break; } - } - - /* - * First we have to close any open cursors. Then we close - * our db. - */ - for (p = LIST_FIRST(&__db_infohead); p != NULL; p = nextp) { - nextp = LIST_NEXT(p, entries); /* - * Check if this is a cursor info structure and if - * it is, if it belongs to this DB. If so, remove - * its commands and info structure. + * If, at any time, parsing the args we get an error, + * bail out and return. */ - if (p->i_parent == dbip && p->i_type == I_DBC) { - (void)Tcl_DeleteCommand(interp, p->i_name); - _DeleteInfo(p); - } + if (result != TCL_OK) + return (result); + if (endarg) + break; } - (void)Tcl_DeleteCommand(interp, dbip->i_name); - _DeleteInfo(dbip); + _DbInfoDelete(interp, dbip); _debug_check(); + + /* Paranoia. */ + dbp->api_internal = NULL; + ret = (dbp)->close(dbp, flag); - result = _ReturnSetup(interp, ret, "db close"); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db close"); return (result); } @@ -453,16 +557,22 @@ tcl_DbPut(interp, objc, objv, dbp) DB *dbp; /* Database pointer */ { static char *dbputopts[] = { - "-append", +#if CONFIG_TEST "-nodupdata", +#endif + "-append", + "-auto_commit", "-nooverwrite", "-partial", "-txn", NULL }; enum dbputopts { - DBPUT_APPEND, +#if CONFIG_TEST DBGET_NODUPDATA, +#endif + DBPUT_APPEND, + DBPUT_AUTO_COMMIT, DBPUT_NOOVER, DBPUT_PART, DBPUT_TXN @@ -475,9 +585,11 @@ tcl_DbPut(interp, objc, objv, dbp) DBTYPE type; DB_TXN *txn; Tcl_Obj **elemv, *res; + void *dtmp, *ktmp; db_recno_t recno; u_int32_t flag; - int elemc, end, i, itmp, optindex, result, ret; + int auto_commit, elemc, end, freekey, freedata; + int i, optindex, result, ret; char *arg, msg[MSG_SIZE]; txn = NULL; @@ -488,6 +600,7 @@ tcl_DbPut(interp, objc, objv, dbp) return (TCL_ERROR); } + freekey = freedata = 0; memset(&key, 0, sizeof(key)); memset(&data, 0, sizeof(data)); @@ -496,7 +609,7 @@ tcl_DbPut(interp, objc, objv, dbp) * and must be setup up to contain a db_recno_t. Otherwise the * key is a "string". */ - type = dbp->get_type(dbp); + (void)dbp->get_type(dbp, &type); /* * We need to determine where the end of required args are. If we @@ -527,12 +640,19 @@ tcl_DbPut(interp, objc, objv, dbp) * defined above. */ i = 2; + auto_commit = 0; while (i < end) { if (Tcl_GetIndexFromObj(interp, objv[i], dbputopts, "option", TCL_EXACT, &optindex) != TCL_OK) return (IS_HELP(objv[i])); i++; switch ((enum dbputopts)optindex) { +#if CONFIG_TEST + case DBGET_NODUPDATA: + FLAG_CHECK(flag); + flag = DB_NODUPDATA; + break; +#endif case DBPUT_TXN: if (i > (end - 1)) { Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?"); @@ -548,14 +668,13 @@ tcl_DbPut(interp, objc, objv, dbp) result = TCL_ERROR; } break; + case DBPUT_AUTO_COMMIT: + auto_commit = 1; + break; case DBPUT_APPEND: FLAG_CHECK(flag); flag = DB_APPEND; break; - case DBGET_NODUPDATA: - FLAG_CHECK(flag); - flag = DB_NODUPDATA; - break; case DBPUT_NOOVER: FLAG_CHECK(flag); flag = DB_NOOVERWRITE; @@ -579,12 +698,10 @@ tcl_DbPut(interp, objc, objv, dbp) break; } data.flags = DB_DBT_PARTIAL; - result = Tcl_GetIntFromObj(interp, elemv[0], &itmp); - data.doff = itmp; + result = _GetUInt32(interp, elemv[0], &data.doff); if (result != TCL_OK) break; - result = Tcl_GetIntFromObj(interp, elemv[1], &itmp); - data.dlen = itmp; + result = _GetUInt32(interp, elemv[1], &data.dlen); /* * NOTE: We don't check result here because all we'd * do is break anyway, and we are doing that. If you @@ -597,6 +714,8 @@ tcl_DbPut(interp, objc, objv, dbp) if (result != TCL_OK) break; } + if (auto_commit) + flag |= DB_AUTO_COMMIT; if (result == TCL_ERROR) return (result); @@ -612,40 +731,41 @@ tcl_DbPut(interp, objc, objv, dbp) if (flag == DB_APPEND) recno = 0; else { - result = Tcl_GetIntFromObj(interp, objv[objc-2], &itmp); - recno = itmp; + result = _GetUInt32(interp, objv[objc-2], &recno); if (result != TCL_OK) return (result); } } else { - key.data = Tcl_GetByteArrayFromObj(objv[objc-2], &itmp); - key.size = itmp; + ret = _CopyObjBytes(interp, objv[objc-2], &ktmp, + &key.size, &freekey); + if (ret != 0) { + result = _ReturnSetup(interp, ret, + DB_RETOK_DBPUT(ret), "db put"); + return (result); + } + key.data = ktmp; } - /* - * XXX - * Tcl 8.1 Tcl_GetByteArrayFromObj/Tcl_GetIntFromObj bug. - * - * This line (and the line for key.data above) were moved from - * the beginning of the function to here. - * - * There is a bug in Tcl 8.1 and byte arrays in that if it happens - * to use an object as both a byte array and something else like - * an int, and you've done a Tcl_GetByteArrayFromObj, then you - * do a Tcl_GetIntFromObj, your memory is deleted. - * - * Workaround is to make sure all Tcl_GetByteArrayFromObj calls - * are done last. - */ - data.data = Tcl_GetByteArrayFromObj(objv[objc-1], &itmp); - data.size = itmp; + ret = _CopyObjBytes(interp, objv[objc-1], &dtmp, + &data.size, &freedata); + if (ret != 0) { + result = _ReturnSetup(interp, ret, + DB_RETOK_DBPUT(ret), "db put"); + goto out; + } + data.data = dtmp; _debug_check(); ret = dbp->put(dbp, txn, &key, &data, flag); - result = _ReturnSetup(interp, ret, "db put"); + result = _ReturnSetup(interp, ret, DB_RETOK_DBPUT(ret), "db put"); if (ret == 0 && (type == DB_RECNO || type == DB_QUEUE) && flag == DB_APPEND) { - res = Tcl_NewIntObj(recno); + res = Tcl_NewLongObj((long)recno); Tcl_SetObjResult(interp, res); } +out: + if (freedata) + (void)__os_free(dbp->dbenv, dtmp); + if (freekey) + (void)__os_free(dbp->dbenv, ktmp); return (result); } @@ -653,13 +773,18 @@ tcl_DbPut(interp, objc, objv, dbp) * tcl_db_get -- */ static int -tcl_DbGet(interp, objc, objv, dbp) +tcl_DbGet(interp, objc, objv, dbp, ispget) Tcl_Interp *interp; /* Interpreter */ int objc; /* How many arguments? */ Tcl_Obj *CONST objv[]; /* The argument objects */ DB *dbp; /* Database pointer */ + int ispget; /* 1 for pget, 0 for get */ { static char *dbgetopts[] = { +#if CONFIG_TEST + "-dirty", + "-multi", +#endif "-consume", "-consume_wait", "-get_both", @@ -668,9 +793,14 @@ tcl_DbGet(interp, objc, objv, dbp) "-recno", "-rmw", "-txn", + "--", NULL }; enum dbgetopts { +#if CONFIG_TEST + DBGET_DIRTY, + DBGET_MULTI, +#endif DBGET_CONSUME, DBGET_CONSUME_WAIT, DBGET_BOTH, @@ -678,21 +808,25 @@ tcl_DbGet(interp, objc, objv, dbp) DBGET_PART, DBGET_RECNO, DBGET_RMW, - DBGET_TXN + DBGET_TXN, + DBGET_ENDARG }; DBC *dbc; - DBT key, data, save; + DBT key, pkey, data, save; DBTYPE type; DB_TXN *txn; Tcl_Obj **elemv, *retlist; - db_recno_t recno; - u_int32_t flag, cflag, isdup, rmw; - int elemc, end, i, itmp, optindex, result, ret, useglob, userecno; + void *dtmp, *ktmp; + u_int32_t flag, cflag, isdup, mflag, rmw; + int bufsize, elemc, end, endarg, freekey, freedata, i; + int optindex, result, ret, useglob, useprecno, userecno; char *arg, *pattern, *prefix, msg[MSG_SIZE]; + db_recno_t precno, recno; result = TCL_OK; - cflag = flag = rmw = 0; - useglob = userecno = 0; + freekey = freedata = 0; + cflag = endarg = flag = mflag = rmw = 0; + useglob = userecno = useprecno = 0; txn = NULL; pattern = prefix = NULL; @@ -705,23 +839,41 @@ tcl_DbGet(interp, objc, objv, dbp) memset(&data, 0, sizeof(data)); memset(&save, 0, sizeof(save)); + /* For the primary key in a pget call. */ + memset(&pkey, 0, sizeof(pkey)); + /* * Get the command name index from the object based on the options * defined above. */ i = 2; - type = dbp->get_type(dbp); + (void)dbp->get_type(dbp, &type); end = objc; while (i < end) { if (Tcl_GetIndexFromObj(interp, objv[i], dbgetopts, "option", TCL_EXACT, &optindex) != TCL_OK) { - if (IS_HELP(objv[i]) == TCL_OK) - return (TCL_OK); - Tcl_ResetResult(interp); + arg = Tcl_GetStringFromObj(objv[i], NULL); + if (arg[0] == '-') { + result = IS_HELP(objv[i]); + goto out; + } else + Tcl_ResetResult(interp); break; } i++; switch ((enum dbgetopts)optindex) { +#if CONFIG_TEST + case DBGET_DIRTY: + rmw |= DB_DIRTY_READ; + break; + case DBGET_MULTI: + mflag |= DB_MULTIPLE; + result = Tcl_GetIntFromObj(interp, objv[i], &bufsize); + if (result != TCL_OK) + goto out; + i++; + break; +#endif case DBGET_BOTH: /* * Change 'end' and make sure we aren't already past @@ -738,7 +890,7 @@ tcl_DbGet(interp, objc, objv, dbp) flag = DB_GET_BOTH; break; case DBGET_TXN: - if (i == end - 1) { + if (i >= end) { Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?"); result = TCL_ERROR; break; @@ -773,7 +925,7 @@ tcl_DbGet(interp, objc, objv, dbp) } break; case DBGET_RMW: - rmw = DB_RMW; + rmw |= DB_RMW; break; case DBGET_PART: end = objc - 1; @@ -795,12 +947,10 @@ tcl_DbGet(interp, objc, objv, dbp) break; } save.flags = DB_DBT_PARTIAL; - result = Tcl_GetIntFromObj(interp, elemv[0], &itmp); - save.doff = itmp; + result = _GetUInt32(interp, elemv[0], &save.doff); if (result != TCL_OK) break; - result = Tcl_GetIntFromObj(interp, elemv[1], &itmp); - save.dlen = itmp; + result = _GetUInt32(interp, elemv[1], &save.dlen); /* * NOTE: We don't check result here because all we'd * do is break anyway, and we are doing that. If you @@ -809,15 +959,54 @@ tcl_DbGet(interp, objc, objv, dbp) * lines above and copy that.) */ break; - } + case DBGET_ENDARG: + endarg = 1; + break; + } /* switch */ if (result != TCL_OK) break; + if (endarg) + break; } if (result != TCL_OK) goto out; if (type == DB_RECNO || type == DB_QUEUE) userecno = 1; + + /* + * Check args we have left versus the flags we were given. + * We might have 0, 1 or 2 left. If we have 0, it must + * be DB_CONSUME*, if 2, then DB_GET_BOTH, all others should + * be 1. + */ + if (((flag == DB_CONSUME || flag == DB_CONSUME_WAIT) && i != objc) || + (flag == DB_GET_BOTH && i != objc - 2)) { + Tcl_SetResult(interp, + "Wrong number of key/data given based on flags specified\n", + TCL_STATIC); + result = TCL_ERROR; + goto out; + } else if (flag == 0 && i != objc - 1) { + Tcl_SetResult(interp, + "Wrong number of key/data given\n", TCL_STATIC); + result = TCL_ERROR; + goto out; + } + + /* + * XXX + * We technically shouldn't be looking inside the dbp like this, + * but this is the only way to figure out whether the primary + * key should also be a recno. + */ + if (ispget) { + if (dbp->s_primary != NULL && + (dbp->s_primary->type == DB_RECNO || + dbp->s_primary->type == DB_QUEUE)) + useprecno = 1; + } + /* * Check for illegal combos of options. */ @@ -862,93 +1051,189 @@ tcl_DbGet(interp, objc, objv, dbp) * ops that don't require returning multiple items, use DB->get * instead of a cursor operation. */ - if (pattern == NULL && (isdup == 0 || + if (pattern == NULL && (isdup == 0 || mflag != 0 || flag == DB_SET_RECNO || flag == DB_GET_BOTH || flag == DB_CONSUME || flag == DB_CONSUME_WAIT)) { if (flag == DB_GET_BOTH) { if (userecno) { - result = Tcl_GetIntFromObj(interp, - objv[(objc - 2)], &itmp); - recno = itmp; + result = _GetUInt32(interp, + objv[(objc - 2)], &recno); if (result == TCL_OK) { key.data = &recno; key.size = sizeof(db_recno_t); } else - return (result); + goto out; } else { - key.data = - Tcl_GetByteArrayFromObj(objv[objc-2], - &itmp); - key.size = itmp; + /* + * Some get calls (SET_*) can change the + * key pointers. So, we need to store + * the allocated key space in a tmp. + */ + ret = _CopyObjBytes(interp, objv[objc-2], + &ktmp, &key.size, &freekey); + if (ret != 0) { + result = _ReturnSetup(interp, ret, + DB_RETOK_DBGET(ret), "db get"); + goto out; + } + key.data = ktmp; } /* * Already checked args above. Fill in key and save. * Save is used in the dbp->get call below to fill in * data. + * + * If the "data" here is really a primary key--that + * is, if we're in a pget--and that primary key + * is a recno, treat it appropriately as an int. */ - save.data = - Tcl_GetByteArrayFromObj(objv[objc-1], &itmp); - save.size = itmp; + if (useprecno) { + result = _GetUInt32(interp, + objv[objc - 1], &precno); + if (result == TCL_OK) { + save.data = &precno; + save.size = sizeof(db_recno_t); + } else + goto out; + } else { + ret = _CopyObjBytes(interp, objv[objc-1], + &dtmp, &save.size, &freedata); + if (ret != 0) { + result = _ReturnSetup(interp, ret, + DB_RETOK_DBGET(ret), "db get"); + goto out; + } + save.data = dtmp; + } } else if (flag != DB_CONSUME && flag != DB_CONSUME_WAIT) { if (userecno) { - result = Tcl_GetIntFromObj( - interp, objv[(objc - 1)], &itmp); - recno = itmp; + result = _GetUInt32( + interp, objv[(objc - 1)], &recno); if (result == TCL_OK) { key.data = &recno; key.size = sizeof(db_recno_t); } else - return (result); + goto out; } else { - key.data = Tcl_GetByteArrayFromObj(objv[objc-1], &itmp); - key.size = itmp; + /* + * Some get calls (SET_*) can change the + * key pointers. So, we need to store + * the allocated key space in a tmp. + */ + ret = _CopyObjBytes(interp, objv[objc-1], + &ktmp, &key.size, &freekey); + if (ret != 0) { + result = _ReturnSetup(interp, ret, + DB_RETOK_DBGET(ret), "db get"); + goto out; + } + key.data = ktmp; + } + if (mflag & DB_MULTIPLE) { + if ((ret = __os_malloc(dbp->dbenv, + bufsize, &save.data)) != 0) { + Tcl_SetResult(interp, + db_strerror(ret), TCL_STATIC); + goto out; + } + save.ulen = bufsize; + F_CLR(&save, DB_DBT_MALLOC); + F_SET(&save, DB_DBT_USERMEM); } } - memset(&data, 0, sizeof(data)); data = save; - _debug_check(); - - ret = dbp->get(dbp, txn, &key, &data, flag | rmw); - result = _ReturnSetup(interp, ret, "db get"); + if (ispget) { + if (flag == DB_GET_BOTH) { + pkey.data = save.data; + pkey.size = save.size; + data.data = NULL; + data.size = 0; + } + F_SET(&pkey, DB_DBT_MALLOC); + _debug_check(); + ret = dbp->pget(dbp, + txn, &key, &pkey, &data, flag | rmw); + } else { + _debug_check(); + ret = dbp->get(dbp, + txn, &key, &data, flag | rmw | mflag); + } + result = _ReturnSetup(interp, ret, DB_RETOK_DBGET(ret), + "db get"); if (ret == 0) { /* * Success. Return a list of the form {name value} * If it was a recno in key.data, we need to convert * into a string/object representation of that recno. */ - if (type == DB_RECNO || type == DB_QUEUE) - result = _SetListRecnoElem(interp, retlist, - *(db_recno_t *)key.data, data.data, - data.size); - else - result = _SetListElem(interp, retlist, - key.data, key.size, data.data, data.size); - /* - * Free space from DB_DBT_MALLOC - */ - __os_free(data.data, data.size); + if (mflag & DB_MULTIPLE) + result = _SetMultiList(interp, + retlist, &key, &data, type, flag); + else if (type == DB_RECNO || type == DB_QUEUE) + if (ispget) + result = _Set3DBTList(interp, + retlist, &key, 1, &pkey, + useprecno, &data); + else + result = _SetListRecnoElem(interp, + retlist, *(db_recno_t *)key.data, + data.data, data.size); + else { + if (ispget) + result = _Set3DBTList(interp, + retlist, &key, 0, &pkey, + useprecno, &data); + else + result = _SetListElem(interp, retlist, + key.data, key.size, + data.data, data.size); + } } + /* + * Free space from DBT. + * + * If we set DB_DBT_MALLOC, we need to free the space if + * and only if we succeeded (and thus if DB allocated + * anything). If DB_DBT_MALLOC is not set, this is a bulk + * get buffer, and needs to be freed no matter what. + */ + if (F_ISSET(&data, DB_DBT_MALLOC) && ret == 0) + __os_ufree(dbp->dbenv, data.data); + else if (!F_ISSET(&data, DB_DBT_MALLOC)) + __os_free(dbp->dbenv, data.data); + if (ispget && ret == 0) + __os_ufree(dbp->dbenv, pkey.data); if (result == TCL_OK) Tcl_SetObjResult(interp, retlist); goto out; } if (userecno) { - result = Tcl_GetIntFromObj(interp, objv[(objc - 1)], &itmp); - recno = itmp; + result = _GetUInt32(interp, objv[(objc - 1)], &recno); if (result == TCL_OK) { key.data = &recno; key.size = sizeof(db_recno_t); } else - return (result); + goto out; } else { - key.data = Tcl_GetByteArrayFromObj(objv[objc-1], &itmp); - key.size = itmp; + /* + * Some get calls (SET_*) can change the + * key pointers. So, we need to store + * the allocated key space in a tmp. + */ + ret = _CopyObjBytes(interp, objv[objc-1], &ktmp, + &key.size, &freekey); + if (ret != 0) { + result = _ReturnSetup(interp, ret, + DB_RETOK_DBGET(ret), "db get"); + return (result); + } + key.data = ktmp; } ret = dbp->cursor(dbp, txn, &dbc, 0); - result = _ReturnSetup(interp, ret, "db cursor"); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db cursor"); if (result == TCL_ERROR) goto out; @@ -988,11 +1273,26 @@ tcl_DbGet(interp, objc, objv, dbp) cflag = DB_SET_RANGE; } else cflag = DB_SET; - _debug_check(); - ret = dbc->c_get(dbc, &key, &data, cflag | rmw); - result = _ReturnSetup(interp, ret, "db get (cursor)"); + if (ispget) { + _debug_check(); + F_SET(&pkey, DB_DBT_MALLOC); + ret = dbc->c_pget(dbc, &key, &pkey, &data, cflag | rmw); + } else { + _debug_check(); + ret = dbc->c_get(dbc, &key, &data, cflag | rmw); + } + result = _ReturnSetup(interp, ret, DB_RETOK_DBCGET(ret), + "db get (cursor)"); if (result == TCL_ERROR) goto out1; + if (ret == 0 && pattern && + memcmp(key.data, prefix, strlen(prefix)) != 0) { + /* + * Free space from DB_DBT_MALLOC + */ + free(data.data); + goto out1; + } if (pattern) cflag = DB_NEXT; else @@ -1002,36 +1302,46 @@ tcl_DbGet(interp, objc, objv, dbp) /* * Build up our {name value} sublist */ - result = _SetListElem(interp, retlist, - key.data, key.size, - data.data, data.size); + if (ispget) + result = _Set3DBTList(interp, retlist, &key, 0, + &pkey, useprecno, &data); + else + result = _SetListElem(interp, retlist, + key.data, key.size, data.data, data.size); /* * Free space from DB_DBT_MALLOC */ - __os_free(data.data, data.size); + if (ispget) + free(pkey.data); + free(data.data); if (result != TCL_OK) break; /* * Append {name value} to return list */ memset(&key, 0, sizeof(key)); + memset(&pkey, 0, sizeof(pkey)); memset(&data, 0, sizeof(data)); /* * Restore any "partial" info we have saved. */ data = save; - ret = dbc->c_get(dbc, &key, &data, cflag | rmw); + if (ispget) { + F_SET(&pkey, DB_DBT_MALLOC); + ret = dbc->c_pget(dbc, &key, &pkey, &data, cflag | rmw); + } else + ret = dbc->c_get(dbc, &key, &data, cflag | rmw); if (ret == 0 && pattern && memcmp(key.data, prefix, strlen(prefix)) != 0) { /* * Free space from DB_DBT_MALLOC */ - __os_free(data.data, data.size); + free(data.data); break; } } - dbc->c_close(dbc); out1: + dbc->c_close(dbc); if (result == TCL_OK) Tcl_SetObjResult(interp, retlist); out: @@ -1041,7 +1351,11 @@ out: * have multiple nuls at the end, so we free using __os_free(). */ if (prefix != NULL) - __os_free(prefix,0); + __os_free(dbp->dbenv, prefix); + if (freedata) + (void)__os_free(dbp->dbenv, dtmp); + if (freekey) + (void)__os_free(dbp->dbenv, ktmp); return (result); } @@ -1056,11 +1370,13 @@ tcl_DbDelete(interp, objc, objv, dbp) DB *dbp; /* Database pointer */ { static char *dbdelopts[] = { + "-auto_commit", "-glob", "-txn", NULL }; enum dbdelopts { + DBDEL_AUTO_COMMIT, DBDEL_GLOB, DBDEL_TXN }; @@ -1068,12 +1384,14 @@ tcl_DbDelete(interp, objc, objv, dbp) DBT key, data; DBTYPE type; DB_TXN *txn; + void *ktmp; db_recno_t recno; - int i, itmp, optindex, result, ret; + int freekey, i, optindex, result, ret; u_int32_t flag; char *arg, *pattern, *prefix, msg[MSG_SIZE]; result = TCL_OK; + freekey = 0; flag = 0; pattern = prefix = NULL; txn = NULL; @@ -1084,17 +1402,17 @@ tcl_DbDelete(interp, objc, objv, dbp) memset(&key, 0, sizeof(key)); /* - * The first arg must be -txn, -glob or a list of keys. + * The first arg must be -auto_commit, -glob, -txn or a list of keys. */ i = 2; while (i < objc) { if (Tcl_GetIndexFromObj(interp, objv[i], dbdelopts, "option", TCL_EXACT, &optindex) != TCL_OK) { /* - * If we don't have a -glob or -txn, then the - * remaining args must be exact keys. - * Reset the result so we don't get - * an errant error message if there is another error. + * If we don't have a -auto_commit, -glob or -txn, + * then the remaining args must be exact keys. + * Reset the result so we don't get an errant error + * message if there is another error. */ if (IS_HELP(objv[i]) == TCL_OK) return (TCL_OK); @@ -1121,6 +1439,9 @@ tcl_DbDelete(interp, objc, objv, dbp) result = TCL_ERROR; } break; + case DBDEL_AUTO_COMMIT: + flag |= DB_AUTO_COMMIT; + break; case DBDEL_GLOB: /* * Get the pattern. Get the prefix and use cursors to @@ -1143,17 +1464,6 @@ tcl_DbDelete(interp, objc, objv, dbp) if (result != TCL_OK) goto out; - - /* - * If we have a pattern AND more keys to process, then there - * is an error. Either we have some number of exact keys, - * or we have a pattern. - */ - if (pattern != NULL && i != objc) { - Tcl_WrongNumArgs(interp, 2, objv, "?args? -glob pattern | key"); - result = TCL_ERROR; - goto out; - } /* * XXX * For consistency with get, we have decided for the moment, to @@ -1163,11 +1473,33 @@ tcl_DbDelete(interp, objc, objv, dbp) * than one, and at that time we'd make delete be consistent. In * any case, the code is already here and there is no need to remove, * just check that we only have one arg left. + * + * If we have a pattern AND more keys to process, there is an error. + * Either we have some number of exact keys, or we have a pattern. + * + * If we have a pattern and an auto commit flag, there is an error. */ - if (pattern == NULL && i != (objc - 1)) { - Tcl_WrongNumArgs(interp, 2, objv, "?args? -glob pattern | key"); - result = TCL_ERROR; - goto out; + if (pattern == NULL) { + if (i != (objc - 1)) { + Tcl_WrongNumArgs( + interp, 2, objv, "?args? -glob pattern | key"); + result = TCL_ERROR; + goto out; + } + } else { + if (i != objc) { + Tcl_WrongNumArgs( + interp, 2, objv, "?args? -glob pattern | key"); + result = TCL_ERROR; + goto out; + } + if (flag & DB_AUTO_COMMIT) { + Tcl_SetResult(interp, + "Cannot use -auto_commit and patterns.\n", + TCL_STATIC); + result = TCL_ERROR; + goto out; + } } /* @@ -1177,32 +1509,39 @@ tcl_DbDelete(interp, objc, objv, dbp) * If it is a RECNO database, the key is a record number and must be * setup up to contain a db_recno_t. Otherwise the key is a "string". */ - type = dbp->get_type(dbp); + (void)dbp->get_type(dbp, &type); ret = 0; while (i < objc && ret == 0) { memset(&key, 0, sizeof(key)); if (type == DB_RECNO || type == DB_QUEUE) { - result = Tcl_GetIntFromObj(interp, objv[i++], &itmp); - recno = itmp; + result = _GetUInt32(interp, objv[i++], &recno); if (result == TCL_OK) { key.data = &recno; key.size = sizeof(db_recno_t); } else return (result); } else { - key.data = Tcl_GetByteArrayFromObj(objv[i++], &itmp); - key.size = itmp; + ret = _CopyObjBytes(interp, objv[i++], &ktmp, + &key.size, &freekey); + if (ret != 0) { + result = _ReturnSetup(interp, ret, + DB_RETOK_DBDEL(ret), "db del"); + return (result); + } + key.data = ktmp; } _debug_check(); - ret = dbp->del(dbp, txn, &key, 0); + ret = dbp->del(dbp, txn, &key, flag); /* * If we have any error, set up return result and stop * processing keys. */ + if (freekey) + (void)__os_free(dbp->dbenv, ktmp); if (ret != 0) break; } - result = _ReturnSetup(interp, ret, "db del"); + result = _ReturnSetup(interp, ret, DB_RETOK_DBDEL(ret), "db del"); /* * At this point we've either finished or, if we have a pattern, @@ -1212,7 +1551,8 @@ tcl_DbDelete(interp, objc, objv, dbp) if (pattern) { ret = dbp->cursor(dbp, txn, &dbc, 0); if (ret != 0) { - result = _ReturnSetup(interp, ret, "db cursor"); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "db cursor"); goto out; } /* @@ -1244,7 +1584,8 @@ tcl_DbDelete(interp, objc, objv, dbp) _debug_check(); ret = dbc->c_del(dbc, 0); if (ret != 0) { - result = _ReturnSetup(interp, ret, "db c_del"); + result = _ReturnSetup(interp, ret, + DB_RETOK_DBCDEL(ret), "db c_del"); break; } /* @@ -1262,9 +1603,9 @@ tcl_DbDelete(interp, objc, objv, dbp) * by copying and condensing another string. Thus prefix may * have multiple nuls at the end, so we free using __os_free(). */ - __os_free(prefix,0); + __os_free(dbp->dbenv, prefix); dbc->c_close(dbc); - result = _ReturnSetup(interp, ret, "db del"); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db del"); } out: return (result); @@ -1282,11 +1623,19 @@ tcl_DbCursor(interp, objc, objv, dbp, dbcp) DBC **dbcp; /* Return cursor pointer */ { static char *dbcuropts[] = { - "-txn", "-update", +#if CONFIG_TEST + "-dirty", + "-update", +#endif + "-txn", NULL }; enum dbcuropts { - DBCUR_TXN, DBCUR_UPDATE +#if CONFIG_TEST + DBCUR_DIRTY, + DBCUR_UPDATE, +#endif + DBCUR_TXN }; DB_TXN *txn; u_int32_t flag; @@ -1296,11 +1645,6 @@ tcl_DbCursor(interp, objc, objv, dbp, dbcp) result = TCL_OK; flag = 0; txn = NULL; - /* - * If the user asks for -glob or -recno, it MUST be the second - * last arg given. If it isn't given, then we must check if - * they gave us a correct key. - */ i = 2; while (i < objc) { if (Tcl_GetIndexFromObj(interp, objv[i], dbcuropts, "option", @@ -1310,6 +1654,14 @@ tcl_DbCursor(interp, objc, objv, dbp, dbcp) } i++; switch ((enum dbcuropts)optindex) { +#if CONFIG_TEST + case DBCUR_DIRTY: + flag |= DB_DIRTY_READ; + break; + case DBCUR_UPDATE: + flag |= DB_WRITECURSOR; + break; +#endif case DBCUR_TXN: if (i == objc) { Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?"); @@ -1325,9 +1677,6 @@ tcl_DbCursor(interp, objc, objv, dbp, dbcp) result = TCL_ERROR; } break; - case DBCUR_UPDATE: - flag = DB_WRITECURSOR; - break; } if (result != TCL_OK) break; @@ -1344,6 +1693,192 @@ out: } /* + * tcl_DbAssociate -- + * Call DB->associate(). + */ +static int +tcl_DbAssociate(interp, objc, objv, dbp) + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; + DB *dbp; +{ + static char *dbaopts[] = { + "-auto_commit", + "-create", + "-txn", + NULL + }; + enum dbaopts { + DBA_AUTO_COMMIT, + DBA_CREATE, + DBA_TXN + }; + DB *sdbp; + DB_TXN *txn; + DBTCL_INFO *sdbip; + int i, optindex, result, ret; + char *arg, msg[MSG_SIZE]; + u_int32_t flag; + + txn = NULL; + result = TCL_OK; + flag = 0; + if (objc < 2) { + Tcl_WrongNumArgs(interp, 2, objv, "[callback] secondary"); + return (TCL_ERROR); + } + + i = 2; + while (i < objc) { + if (Tcl_GetIndexFromObj(interp, objv[i], dbaopts, "option", + TCL_EXACT, &optindex) != TCL_OK) { + result = IS_HELP(objv[i]); + if (result == TCL_OK) + return (result); + result = TCL_OK; + Tcl_ResetResult(interp); + break; + } + i++; + switch ((enum dbaopts)optindex) { + case DBA_AUTO_COMMIT: + flag |= DB_AUTO_COMMIT; + break; + case DBA_CREATE: + flag |= DB_CREATE; + break; + case DBA_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, + "Associate: Invalid txn: %s\n", arg); + Tcl_SetResult(interp, msg, TCL_VOLATILE); + result = TCL_ERROR; + } + break; + } + } + if (result != TCL_OK) + return (result); + + /* + * Better be 1 or 2 args left. The last arg must be the sdb + * handle. If 2 args then objc-2 is the callback proc, else + * we have a NULL callback. + */ + /* Get the secondary DB handle. */ + arg = Tcl_GetStringFromObj(objv[objc - 1], NULL); + sdbp = NAME_TO_DB(arg); + if (sdbp == NULL) { + snprintf(msg, MSG_SIZE, + "Associate: Invalid database handle: %s\n", arg); + Tcl_SetResult(interp, msg, TCL_VOLATILE); + return (TCL_ERROR); + } + + /* + * The callback is simply a Tcl object containing the name + * of the callback proc, which is the second-to-last argument. + * + * Note that the callback needs to go in the *secondary* DB handle's + * info struct; we may have multiple secondaries with different + * callbacks. + */ + sdbip = (DBTCL_INFO *)sdbp->api_internal; + if (i != objc - 1) { + /* + * We have 2 args, get the callback. + */ + sdbip->i_second_call = objv[objc - 2]; + Tcl_IncrRefCount(sdbip->i_second_call); + + /* Now call associate. */ + _debug_check(); + ret = dbp->associate(dbp, txn, sdbp, tcl_second_call, flag); + } else { + /* + * We have a NULL callback. + */ + sdbip->i_second_call = NULL; + ret = dbp->associate(dbp, txn, sdbp, NULL, flag); + } + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "associate"); + + return (result); +} + +/* + * tcl_second_call -- + * Callback function for secondary indices. Get the callback + * out of ip->i_second_call and call it. + */ +static int +tcl_second_call(dbp, pkey, data, skey) + DB *dbp; + const DBT *pkey, *data; + DBT *skey; +{ + DBTCL_INFO *ip; + Tcl_Interp *interp; + Tcl_Obj *pobj, *dobj, *objv[3]; + int len, result, ret; + void *retbuf, *databuf; + + ip = (DBTCL_INFO *)dbp->api_internal; + interp = ip->i_interp; + objv[0] = ip->i_second_call; + + /* + * Create two ByteArray objects, with the contents of the pkey + * and data DBTs that are our inputs. + */ + pobj = Tcl_NewByteArrayObj(pkey->data, pkey->size); + Tcl_IncrRefCount(pobj); + dobj = Tcl_NewByteArrayObj(data->data, data->size); + Tcl_IncrRefCount(dobj); + + objv[1] = pobj; + objv[2] = dobj; + + result = Tcl_EvalObjv(interp, 3, objv, 0); + + Tcl_DecrRefCount(pobj); + Tcl_DecrRefCount(dobj); + + if (result != TCL_OK) { + __db_err(dbp->dbenv, + "Tcl callback function failed with code %d", result); + return (EINVAL); + } + + retbuf = + Tcl_GetByteArrayFromObj(Tcl_GetObjResult(interp), &len); + + /* + * retbuf is owned by Tcl; copy it into malloc'ed memory. + * We need to use __os_umalloc rather than ufree because this will + * be freed by DB using __os_ufree--the DB_DBT_APPMALLOC flag + * tells DB to free application-allocated memory. + */ + if ((ret = __os_umalloc(dbp->dbenv, len, &databuf)) != 0) + return (ret); + memcpy(databuf, retbuf, len); + + skey->data = databuf; + skey->size = len; + F_SET(skey, DB_DBT_APPMALLOC); + + return (0); +} + +/* * tcl_db_join -- */ static int @@ -1399,7 +1934,7 @@ tcl_DbJoin(interp, objc, objv, dbp, dbcp) * Allocate one more for NULL ptr at end of list. */ size = sizeof(DBC *) * ((objc - adj) + 1); - ret = __os_malloc(dbp->dbenv, size, NULL, &listp); + ret = __os_malloc(dbp->dbenv, size, &listp); if (ret != 0) { Tcl_SetResult(interp, db_strerror(ret), TCL_STATIC); return (TCL_ERROR); @@ -1420,10 +1955,10 @@ tcl_DbJoin(interp, objc, objv, dbp, dbcp) listp[j] = NULL; _debug_check(); ret = dbp->join(dbp, listp, dbcp, flag); - result = _ReturnSetup(interp, ret, "db join"); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db join"); out: - __os_free(listp, size); + __os_free(dbp->dbenv, listp); return (result); } @@ -1438,12 +1973,16 @@ tcl_DbGetjoin(interp, objc, objv, dbp) DB *dbp; /* Database pointer */ { static char *dbgetjopts[] = { +#if CONFIG_TEST "-nosort", +#endif "-txn", NULL }; enum dbgetjopts { +#if CONFIG_TEST DBGETJ_NOSORT, +#endif DBGETJ_TXN }; DB_TXN *txn; @@ -1452,12 +1991,14 @@ tcl_DbGetjoin(interp, objc, objv, dbp) DBC *dbc; DBT key, data; Tcl_Obj **elemv, *retlist; + void *ktmp; u_int32_t flag; - int adj, elemc, i, itmp, j, optindex, result, ret, size; + int adj, elemc, freekey, i, j, optindex, result, ret, size; char *arg, msg[MSG_SIZE]; result = TCL_OK; flag = 0; + freekey = 0; if (objc < 3) { Tcl_WrongNumArgs(interp, 2, objv, "{db1 key1} {db2 key2} ..."); return (TCL_ERROR); @@ -1478,10 +2019,12 @@ tcl_DbGetjoin(interp, objc, objv, dbp) } i++; switch ((enum dbgetjopts)optindex) { +#if CONFIG_TEST case DBGETJ_NOSORT: flag |= DB_JOIN_NOSORT; adj++; break; +#endif case DBGETJ_TXN: if (i == objc) { Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?"); @@ -1503,7 +2046,7 @@ tcl_DbGetjoin(interp, objc, objv, dbp) if (result != TCL_OK) return (result); size = sizeof(DBC *) * ((objc - adj) + 1); - ret = __os_malloc(NULL, size, NULL, &listp); + ret = __os_malloc(NULL, size, &listp); if (ret != 0) { Tcl_SetResult(interp, db_strerror(ret), TCL_STATIC); return (TCL_ERROR); @@ -1535,22 +2078,28 @@ tcl_DbGetjoin(interp, objc, objv, dbp) goto out; } ret = elemdbp->cursor(elemdbp, txn, &listp[j], 0); - if ((result = _ReturnSetup(interp, ret, "db cursor")) == - TCL_ERROR) + if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "db cursor")) == TCL_ERROR) goto out; memset(&key, 0, sizeof(key)); memset(&data, 0, sizeof(data)); - key.data = Tcl_GetByteArrayFromObj(elemv[elemc-1], &itmp); - key.size = itmp; + ret = _CopyObjBytes(interp, elemv[elemc-1], &ktmp, + &key.size, &freekey); + if (ret != 0) { + result = _ReturnSetup(interp, ret, + DB_RETOK_STD(ret), "db join"); + goto out; + } + key.data = ktmp; ret = (listp[j])->c_get(listp[j], &key, &data, DB_SET); - if ((result = _ReturnSetup(interp, ret, "db cget")) == - TCL_ERROR) + if ((result = _ReturnSetup(interp, ret, DB_RETOK_DBCGET(ret), + "db cget")) == TCL_ERROR) goto out; } listp[j] = NULL; _debug_check(); ret = dbp->join(dbp, listp, &dbc, flag); - result = _ReturnSetup(interp, ret, "db join"); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db join"); if (result == TCL_ERROR) goto out; @@ -1568,20 +2117,22 @@ tcl_DbGetjoin(interp, objc, objv, dbp) result = _SetListElem(interp, retlist, key.data, key.size, data.data, data.size); - __os_free(key.data, key.size); - __os_free(data.data, data.size); + free(key.data); + free(data.data); } } dbc->c_close(dbc); if (result == TCL_OK) Tcl_SetObjResult(interp, retlist); out: + if (freekey) + (void)__os_free(dbp->dbenv, ktmp); while (j) { if (listp[j]) (listp[j])->c_close(listp[j]); j--; } - __os_free(listp, size); + __os_free(dbp->dbenv, listp); return (result); } @@ -1598,11 +2149,13 @@ tcl_DbCount(interp, objc, objv, dbp) Tcl_Obj *res; DBC *dbc; DBT key, data; + void *ktmp; db_recno_t count, recno; - int itmp, len, result, ret; + int freekey, result, ret; result = TCL_OK; count = 0; + freekey = 0; res = NULL; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "key"); @@ -1624,21 +2177,27 @@ tcl_DbCount(interp, objc, objv, dbp) * treat the key as a recno rather than as a byte string. */ if (dbp->type == DB_RECNO || dbp->type == DB_QUEUE) { - result = Tcl_GetIntFromObj(interp, objv[2], &itmp); - recno = itmp; + result = _GetUInt32(interp, objv[2], &recno); if (result == TCL_OK) { key.data = &recno; key.size = sizeof(db_recno_t); } else return (result); } else { - key.data = Tcl_GetByteArrayFromObj(objv[2], &len); - key.size = len; + ret = _CopyObjBytes(interp, objv[2], &ktmp, + &key.size, &freekey); + if (ret != 0) { + result = _ReturnSetup(interp, ret, + DB_RETOK_STD(ret), "db count"); + return (result); + } + key.data = ktmp; } _debug_check(); ret = dbp->cursor(dbp, NULL, &dbc, 0); if (ret != 0) { - result = _ReturnSetup(interp, ret, "db cursor"); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "db cursor"); goto out; } /* @@ -1650,16 +2209,21 @@ tcl_DbCount(interp, objc, objv, dbp) else { ret = dbc->c_count(dbc, &count, 0); if (ret != 0) { - result = _ReturnSetup(interp, ret, "db cursor"); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "db c count"); goto out; } } - res = Tcl_NewIntObj(count); + res = Tcl_NewLongObj((long)count); Tcl_SetObjResult(interp, res); out: + if (freekey) + (void)__os_free(dbp->dbenv, ktmp); + (void)dbc->c_close(dbc); return (result); } +#if CONFIG_TEST /* * tcl_DbKeyRange -- */ @@ -1682,13 +2246,15 @@ tcl_DbKeyRange(interp, objc, objv, dbp) DBT key; DBTYPE type; Tcl_Obj *myobjv[3], *retlist; + void *ktmp; db_recno_t recno; u_int32_t flag; - int i, itmp, myobjc, optindex, result, ret; + int freekey, i, myobjc, optindex, result, ret; char *arg, msg[MSG_SIZE]; result = TCL_OK; flag = 0; + freekey = 0; if (objc < 3) { Tcl_WrongNumArgs(interp, 2, objv, "?-txn id? key"); return (TCL_ERROR); @@ -1727,7 +2293,7 @@ tcl_DbKeyRange(interp, objc, objv, dbp) } if (result != TCL_OK) return (result); - type = dbp->get_type(dbp); + (void)dbp->get_type(dbp, &type); ret = 0; /* * Make sure we have a key. @@ -1739,20 +2305,25 @@ tcl_DbKeyRange(interp, objc, objv, dbp) } memset(&key, 0, sizeof(key)); if (type == DB_RECNO || type == DB_QUEUE) { - result = Tcl_GetIntFromObj(interp, objv[i], &itmp); - recno = itmp; + result = _GetUInt32(interp, objv[i], &recno); if (result == TCL_OK) { key.data = &recno; key.size = sizeof(db_recno_t); } else return (result); } else { - key.data = Tcl_GetByteArrayFromObj(objv[i++], &itmp); - key.size = itmp; + ret = _CopyObjBytes(interp, objv[i++], &ktmp, + &key.size, &freekey); + if (ret != 0) { + result = _ReturnSetup(interp, ret, + DB_RETOK_STD(ret), "db keyrange"); + return (result); + } + key.data = ktmp; } _debug_check(); ret = dbp->key_range(dbp, txn, &key, &range, flag); - result = _ReturnSetup(interp, ret, "db join"); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db keyrange"); if (result == TCL_ERROR) goto out; @@ -1767,5 +2338,84 @@ tcl_DbKeyRange(interp, objc, objv, dbp) if (result == TCL_OK) Tcl_SetObjResult(interp, retlist); out: + if (freekey) + (void)__os_free(dbp->dbenv, ktmp); + return (result); +} +#endif + +/* + * tcl_DbTruncate -- + */ +static int +tcl_DbTruncate(interp, objc, objv, dbp) + Tcl_Interp *interp; /* Interpreter */ + int objc; /* How many arguments? */ + Tcl_Obj *CONST objv[]; /* The argument objects */ + DB *dbp; /* Database pointer */ +{ + static char *dbcuropts[] = { + "-auto_commit", + "-txn", + NULL + }; + enum dbcuropts { + DBTRUNC_AUTO_COMMIT, + DBTRUNC_TXN + }; + DB_TXN *txn; + Tcl_Obj *res; + u_int32_t count, flag; + int i, optindex, result, ret; + char *arg, msg[MSG_SIZE]; + + txn = NULL; + flag = 0; + result = TCL_OK; + + i = 2; + while (i < objc) { + if (Tcl_GetIndexFromObj(interp, objv[i], dbcuropts, "option", + TCL_EXACT, &optindex) != TCL_OK) { + result = IS_HELP(objv[i]); + goto out; + } + i++; + switch ((enum dbcuropts)optindex) { + case DBTRUNC_AUTO_COMMIT: + flag |= DB_AUTO_COMMIT; + break; + case DBTRUNC_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, + "Truncate: Invalid txn: %s\n", arg); + Tcl_SetResult(interp, msg, TCL_VOLATILE); + result = TCL_ERROR; + } + break; + } + if (result != TCL_OK) + break; + } + if (result != TCL_OK) + goto out; + + _debug_check(); + ret = dbp->truncate(dbp, txn, &count, flag); + if (ret != 0) + result = _ErrorSetup(interp, ret, "db truncate"); + + else { + res = Tcl_NewLongObj((long)count); + Tcl_SetObjResult(interp, res); + } +out: return (result); } 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 diff --git a/bdb/tcl/tcl_dbcursor.c b/bdb/tcl/tcl_dbcursor.c index 26e7b58c64a..fb426e53f48 100644 --- a/bdb/tcl/tcl_dbcursor.c +++ b/bdb/tcl/tcl_dbcursor.c @@ -1,14 +1,14 @@ /*- * See the file LICENSE for redistribution information. * - * Copyright (c) 1999, 2000 + * Copyright (c) 1999-2001 * Sleepycat Software. All rights reserved. */ #include "db_config.h" #ifndef lint -static const char revid[] = "$Id: tcl_dbcursor.c,v 11.26 2001/01/11 18:19:55 bostic Exp $"; +static const char revid[] = "$Id: tcl_dbcursor.c,v 11.51 2002/08/06 06:20:59 bostic Exp $"; #endif /* not lint */ #ifndef NO_SYSTEM_INCLUDES @@ -20,14 +20,14 @@ static const char revid[] = "$Id: tcl_dbcursor.c,v 11.26 2001/01/11 18:19:55 bos #endif #include "db_int.h" -#include "tcl_db.h" +#include "dbinc/tcl_db.h" /* * Prototypes for procedures defined later in this file: */ -static int tcl_DbcDup __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DBC *)); -static int tcl_DbcGet __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DBC *)); -static int tcl_DbcPut __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DBC *)); +static int tcl_DbcDup __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DBC *)); +static int tcl_DbcGet __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DBC *, int)); +static int tcl_DbcPut __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DBC *)); /* * PUBLIC: int dbc_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*)); @@ -37,12 +37,15 @@ static int tcl_DbcPut __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DBC *)); */ int dbc_Cmd(clientData, interp, objc, objv) - ClientData clientData; /* Cursor handle */ - Tcl_Interp *interp; /* Interpreter */ - int objc; /* How many arguments? */ - Tcl_Obj *CONST objv[]; /* The argument objects */ + ClientData clientData; /* Cursor handle */ + Tcl_Interp *interp; /* Interpreter */ + int objc; /* How many arguments? */ + Tcl_Obj *CONST objv[]; /* The argument objects */ { static char *dbccmds[] = { +#if CONFIG_TEST + "pget", +#endif "close", "del", "dup", @@ -51,6 +54,9 @@ dbc_Cmd(clientData, interp, objc, objv) NULL }; enum dbccmds { +#if CONFIG_TEST + DBCPGET, +#endif DBCCLOSE, DBCDELETE, DBCDUP, @@ -87,6 +93,11 @@ dbc_Cmd(clientData, interp, objc, objv) TCL_EXACT, &cmdindex) != TCL_OK) return (IS_HELP(objv[1])); switch ((enum dbccmds)cmdindex) { +#if CONFIG_TEST + case DBCPGET: + result = tcl_DbcGet(interp, objc, objv, dbc, 1); + break; +#endif case DBCCLOSE: /* * No args for this. Error if there are some. @@ -97,7 +108,8 @@ dbc_Cmd(clientData, interp, objc, objv) } _debug_check(); ret = dbc->c_close(dbc); - result = _ReturnSetup(interp, ret, "dbc close"); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "dbc close"); if (result == TCL_OK) { (void)Tcl_DeleteCommand(interp, dbip->i_name); _DeleteInfo(dbip); @@ -113,13 +125,14 @@ dbc_Cmd(clientData, interp, objc, objv) } _debug_check(); ret = dbc->c_del(dbc, 0); - result = _ReturnSetup(interp, ret, "dbc delete"); + result = _ReturnSetup(interp, ret, DB_RETOK_DBCDEL(ret), + "dbc delete"); break; case DBCDUP: result = tcl_DbcDup(interp, objc, objv, dbc); break; case DBCGET: - result = tcl_DbcGet(interp, objc, objv, dbc); + result = tcl_DbcGet(interp, objc, objv, dbc, 0); break; case DBCPUT: result = tcl_DbcPut(interp, objc, objv, dbc); @@ -139,14 +152,26 @@ tcl_DbcPut(interp, objc, objv, dbc) DBC *dbc; /* Cursor pointer */ { static char *dbcutopts[] = { - "-after", "-before", "-current", - "-keyfirst", "-keylast", "-nodupdata", +#if CONFIG_TEST + "-nodupdata", +#endif + "-after", + "-before", + "-current", + "-keyfirst", + "-keylast", "-partial", NULL }; enum dbcutopts { - DBCPUT_AFTER, DBCPUT_BEFORE, DBCPUT_CURRENT, - DBCPUT_KEYFIRST,DBCPUT_KEYLAST, DBCPUT_NODUPDATA, +#if CONFIG_TEST + DBCPUT_NODUPDATA, +#endif + DBCPUT_AFTER, + DBCPUT_BEFORE, + DBCPUT_CURRENT, + DBCPUT_KEYFIRST, + DBCPUT_KEYLAST, DBCPUT_PART }; DB *thisdbp; @@ -154,12 +179,14 @@ tcl_DbcPut(interp, objc, objv, dbc) DBTCL_INFO *dbcip, *dbip; DBTYPE type; Tcl_Obj **elemv, *res; + void *dtmp, *ktmp; db_recno_t recno; u_int32_t flag; - int elemc, i, itmp, optindex, result, ret; + int elemc, freekey, freedata, i, optindex, result, ret; result = TCL_OK; flag = 0; + freekey = freedata = 0; if (objc < 2) { Tcl_WrongNumArgs(interp, 2, objv, "?-args? ?key?"); @@ -190,6 +217,12 @@ tcl_DbcPut(interp, objc, objv, dbc) } i++; switch ((enum dbcutopts)optindex) { +#if CONFIG_TEST + case DBCPUT_NODUPDATA: + FLAG_CHECK(flag); + flag = DB_NODUPDATA; + break; +#endif case DBCPUT_AFTER: FLAG_CHECK(flag); flag = DB_AFTER; @@ -210,10 +243,6 @@ tcl_DbcPut(interp, objc, objv, dbc) FLAG_CHECK(flag); flag = DB_KEYLAST; break; - case DBCPUT_NODUPDATA: - FLAG_CHECK(flag); - flag = DB_NODUPDATA; - break; case DBCPUT_PART: if (i > (objc - 2)) { Tcl_WrongNumArgs(interp, 2, objv, @@ -233,12 +262,10 @@ tcl_DbcPut(interp, objc, objv, dbc) break; } data.flags |= DB_DBT_PARTIAL; - result = Tcl_GetIntFromObj(interp, elemv[0], &itmp); - data.doff = itmp; + result = _GetUInt32(interp, elemv[0], &data.doff); if (result != TCL_OK) break; - result = Tcl_GetIntFromObj(interp, elemv[1], &itmp); - data.dlen = itmp; + result = _GetUInt32(interp, elemv[1], &data.dlen); /* * NOTE: We don't check result here because all we'd * do is break anyway, and we are doing that. If you @@ -269,7 +296,7 @@ tcl_DbcPut(interp, objc, objv, dbc) return (result); } thisdbp = dbip->i_dbp; - type = thisdbp->get_type(thisdbp); + (void)thisdbp->get_type(thisdbp, &type); } /* * When we get here, we better have: @@ -300,29 +327,45 @@ tcl_DbcPut(interp, objc, objv, dbc) goto out; } if (type == DB_RECNO || type == DB_QUEUE) { - result = Tcl_GetIntFromObj(interp, objv[objc-2], &itmp); - recno = itmp; + result = _GetUInt32(interp, objv[objc-2], &recno); if (result == TCL_OK) { key.data = &recno; key.size = sizeof(db_recno_t); } else return (result); } else { - key.data = Tcl_GetByteArrayFromObj(objv[objc-2], &itmp); - key.size = itmp; + ret = _CopyObjBytes(interp, objv[objc-2], &ktmp, + &key.size, &freekey); + if (ret != 0) { + result = _ReturnSetup(interp, ret, + DB_RETOK_DBCPUT(ret), "dbc put"); + return (result); + } + key.data = ktmp; } } - data.data = Tcl_GetByteArrayFromObj(objv[objc-1], &itmp); - data.size = itmp; + ret = _CopyObjBytes(interp, objv[objc-1], &dtmp, + &data.size, &freedata); + data.data = dtmp; + if (ret != 0) { + result = _ReturnSetup(interp, ret, + DB_RETOK_DBCPUT(ret), "dbc put"); + goto out; + } _debug_check(); ret = dbc->c_put(dbc, &key, &data, flag); - result = _ReturnSetup(interp, ret, "dbc put"); - if (ret == 0 && (flag == DB_AFTER || flag == DB_BEFORE) - && type == DB_RECNO) { - res = Tcl_NewIntObj(*(db_recno_t *)key.data); + result = _ReturnSetup(interp, ret, DB_RETOK_DBCPUT(ret), + "dbc put"); + if (ret == 0 && + (flag == DB_AFTER || flag == DB_BEFORE) && type == DB_RECNO) { + res = Tcl_NewLongObj((long)*(db_recno_t *)key.data); Tcl_SetObjResult(interp, res); } out: + if (freedata) + (void)__os_free(NULL, dtmp); + if (freekey) + (void)__os_free(NULL, ktmp); return (result); } @@ -330,13 +373,20 @@ out: * tcl_dbc_get -- */ static int -tcl_DbcGet(interp, objc, objv, dbc) +tcl_DbcGet(interp, objc, objv, dbc, ispget) Tcl_Interp *interp; /* Interpreter */ int objc; /* How many arguments? */ Tcl_Obj *CONST objv[]; /* The argument objects */ DBC *dbc; /* Cursor pointer */ + int ispget; /* 1 for pget, 0 for get */ { static char *dbcgetopts[] = { +#if CONFIG_TEST + "-dirty", + "-get_both_range", + "-multi", + "-multi_key", +#endif "-current", "-first", "-get_both", @@ -356,6 +406,12 @@ tcl_DbcGet(interp, objc, objv, dbc) NULL }; enum dbcgetopts { +#if CONFIG_TEST + DBCGET_DIRTY, + DBCGET_BOTH_RANGE, + DBCGET_MULTI, + DBCGET_MULTI_KEY, +#endif DBCGET_CURRENT, DBCGET_FIRST, DBCGET_BOTH, @@ -374,16 +430,18 @@ tcl_DbcGet(interp, objc, objv, dbc) DBCGET_SETRECNO }; DB *thisdbp; - DBT key, data; + DBT key, data, pdata; DBTCL_INFO *dbcip, *dbip; - DBTYPE type; + DBTYPE ptype, type; Tcl_Obj **elemv, *myobj, *retlist; - db_recno_t recno; - u_int32_t flag; - int elemc, i, itmp, optindex, result, ret; + void *dtmp, *ktmp; + db_recno_t precno, recno; + u_int32_t flag, op; + int bufsize, elemc, freekey, freedata, i, optindex, result, ret; result = TCL_OK; flag = 0; + freekey = freedata = 0; if (objc < 2) { Tcl_WrongNumArgs(interp, 2, objv, "?-args? ?key?"); @@ -413,63 +471,101 @@ tcl_DbcGet(interp, objc, objv, dbc) } i++; switch ((enum dbcgetopts)optindex) { +#if CONFIG_TEST + case DBCGET_DIRTY: + flag |= DB_DIRTY_READ; + break; + case DBCGET_BOTH_RANGE: + FLAG_CHECK2(flag, + DB_RMW|DB_MULTIPLE|DB_MULTIPLE_KEY|DB_DIRTY_READ); + flag |= DB_GET_BOTH_RANGE; + break; + case DBCGET_MULTI: + flag |= DB_MULTIPLE; + result = Tcl_GetIntFromObj(interp, objv[i], &bufsize); + if (result != TCL_OK) + goto out; + i++; + break; + case DBCGET_MULTI_KEY: + flag |= DB_MULTIPLE_KEY; + result = Tcl_GetIntFromObj(interp, objv[i], &bufsize); + if (result != TCL_OK) + goto out; + i++; + break; +#endif case DBCGET_RMW: flag |= DB_RMW; break; case DBCGET_CURRENT: - FLAG_CHECK2(flag, DB_RMW); + FLAG_CHECK2(flag, + DB_RMW|DB_MULTIPLE|DB_MULTIPLE_KEY|DB_DIRTY_READ); flag |= DB_CURRENT; break; case DBCGET_FIRST: - FLAG_CHECK2(flag, DB_RMW); + FLAG_CHECK2(flag, + DB_RMW|DB_MULTIPLE|DB_MULTIPLE_KEY|DB_DIRTY_READ); flag |= DB_FIRST; break; case DBCGET_LAST: - FLAG_CHECK2(flag, DB_RMW); + FLAG_CHECK2(flag, + DB_RMW|DB_MULTIPLE|DB_MULTIPLE_KEY|DB_DIRTY_READ); flag |= DB_LAST; break; case DBCGET_NEXT: - FLAG_CHECK2(flag, DB_RMW); + FLAG_CHECK2(flag, + DB_RMW|DB_MULTIPLE|DB_MULTIPLE_KEY|DB_DIRTY_READ); flag |= DB_NEXT; break; case DBCGET_PREV: - FLAG_CHECK2(flag, DB_RMW); + FLAG_CHECK2(flag, + DB_RMW|DB_MULTIPLE|DB_MULTIPLE_KEY|DB_DIRTY_READ); flag |= DB_PREV; break; case DBCGET_PREVNODUP: - FLAG_CHECK2(flag, DB_RMW); + FLAG_CHECK2(flag, + DB_RMW|DB_MULTIPLE|DB_MULTIPLE_KEY|DB_DIRTY_READ); flag |= DB_PREV_NODUP; break; case DBCGET_NEXTNODUP: - FLAG_CHECK2(flag, DB_RMW); + FLAG_CHECK2(flag, + DB_RMW|DB_MULTIPLE|DB_MULTIPLE_KEY|DB_DIRTY_READ); flag |= DB_NEXT_NODUP; break; case DBCGET_NEXTDUP: - FLAG_CHECK2(flag, DB_RMW); + FLAG_CHECK2(flag, + DB_RMW|DB_MULTIPLE|DB_MULTIPLE_KEY|DB_DIRTY_READ); flag |= DB_NEXT_DUP; break; case DBCGET_BOTH: - FLAG_CHECK2(flag, DB_RMW); + FLAG_CHECK2(flag, + DB_RMW|DB_MULTIPLE|DB_MULTIPLE_KEY|DB_DIRTY_READ); flag |= DB_GET_BOTH; break; case DBCGET_RECNO: - FLAG_CHECK2(flag, DB_RMW); + FLAG_CHECK2(flag, + DB_RMW|DB_MULTIPLE|DB_MULTIPLE_KEY|DB_DIRTY_READ); flag |= DB_GET_RECNO; break; case DBCGET_JOIN: - FLAG_CHECK2(flag, DB_RMW); + FLAG_CHECK2(flag, + DB_RMW|DB_MULTIPLE|DB_MULTIPLE_KEY|DB_DIRTY_READ); flag |= DB_JOIN_ITEM; break; case DBCGET_SET: - FLAG_CHECK2(flag, DB_RMW); + FLAG_CHECK2(flag, + DB_RMW|DB_MULTIPLE|DB_MULTIPLE_KEY|DB_DIRTY_READ); flag |= DB_SET; break; case DBCGET_SETRANGE: - FLAG_CHECK2(flag, DB_RMW); + FLAG_CHECK2(flag, + DB_RMW|DB_MULTIPLE|DB_MULTIPLE_KEY|DB_DIRTY_READ); flag |= DB_SET_RANGE; break; case DBCGET_SETRECNO: - FLAG_CHECK2(flag, DB_RMW); + FLAG_CHECK2(flag, + DB_RMW|DB_MULTIPLE|DB_MULTIPLE_KEY|DB_DIRTY_READ); flag |= DB_SET_RECNO; break; case DBCGET_PART: @@ -491,12 +587,10 @@ tcl_DbcGet(interp, objc, objv, dbc) break; } data.flags |= DB_DBT_PARTIAL; - result = Tcl_GetIntFromObj(interp, elemv[0], &itmp); - data.doff = itmp; + result = _GetUInt32(interp, elemv[0], &data.doff); if (result != TCL_OK) break; - result = Tcl_GetIntFromObj(interp, elemv[1], &itmp); - data.dlen = itmp; + result = _GetUInt32(interp, elemv[1], &data.dlen); /* * NOTE: We don't check result here because all we'd * do is break anyway, and we are doing that. If you @@ -518,9 +612,10 @@ tcl_DbcGet(interp, objc, objv, dbc) * a string. */ dbcip = _PtrToInfo(dbc); - if (dbcip == NULL) + if (dbcip == NULL) { type = DB_UNKNOWN; - else { + ptype = DB_UNKNOWN; + } else { dbip = dbcip->i_parent; if (dbip == NULL) { Tcl_SetResult(interp, "Cursor without parent database", @@ -529,15 +624,25 @@ tcl_DbcGet(interp, objc, objv, dbc) goto out; } thisdbp = dbip->i_dbp; - type = thisdbp->get_type(thisdbp); + (void)thisdbp->get_type(thisdbp, &type); + if (ispget && thisdbp->s_primary != NULL) + (void)thisdbp-> + s_primary->get_type(thisdbp->s_primary, &ptype); + else + ptype = DB_UNKNOWN; } /* * When we get here, we better have: - * 2 args, key and data if GET_BOTH was specified. + * 2 args, key and data if GET_BOTH/GET_BOTH_RANGE was specified. * 1 arg if -set, -set_range or -set_recno * 0 in all other cases. */ - if ((flag & DB_OPFLAGS_MASK) == DB_GET_BOTH) { + op = flag & DB_OPFLAGS_MASK; + switch (op) { + case DB_GET_BOTH: +#if CONFIG_TEST + case DB_GET_BOTH_RANGE: +#endif if (i != (objc - 2)) { Tcl_WrongNumArgs(interp, 2, objv, "?-args? -get_both key data"); @@ -545,82 +650,158 @@ tcl_DbcGet(interp, objc, objv, dbc) goto out; } else { if (type == DB_RECNO || type == DB_QUEUE) { - result = Tcl_GetIntFromObj( - interp, objv[objc-2], &itmp); - recno = itmp; + result = _GetUInt32( + interp, objv[objc-2], &recno); if (result == TCL_OK) { key.data = &recno; key.size = sizeof(db_recno_t); } else goto out; } else { - key.data = Tcl_GetByteArrayFromObj( - objv[objc - 2], &itmp); - key.size = itmp; + /* + * Some get calls (SET_*) can change the + * key pointers. So, we need to store + * the allocated key space in a tmp. + */ + ret = _CopyObjBytes(interp, objv[objc-2], + &ktmp, &key.size, &freekey); + if (ret != 0) { + result = _ReturnSetup(interp, ret, + DB_RETOK_DBCGET(ret), "dbc get"); + return (result); + } + key.data = ktmp; + } + if (ptype == DB_RECNO || ptype == DB_QUEUE) { + result = _GetUInt32( + interp, objv[objc-1], &precno); + if (result == TCL_OK) { + data.data = &precno; + data.size = sizeof(db_recno_t); + } else + goto out; + } else { + ret = _CopyObjBytes(interp, objv[objc-1], + &dtmp, &data.size, &freedata); + if (ret != 0) { + result = _ReturnSetup(interp, ret, + DB_RETOK_DBCGET(ret), "dbc get"); + goto out; + } + data.data = dtmp; } - data.data = - Tcl_GetByteArrayFromObj(objv[objc - 1], &itmp); - data.size = itmp; } - } else if ((flag & DB_OPFLAGS_MASK) == DB_SET || - (flag & DB_OPFLAGS_MASK) == DB_SET_RANGE || - (flag & DB_OPFLAGS_MASK) == DB_SET_RECNO) { + break; + case DB_SET: + case DB_SET_RANGE: + case DB_SET_RECNO: if (i != (objc - 1)) { Tcl_WrongNumArgs(interp, 2, objv, "?-args? key"); result = TCL_ERROR; goto out; } - data.flags |= DB_DBT_MALLOC; - if ((flag & DB_OPFLAGS_MASK) == DB_SET_RECNO || + if (flag & (DB_MULTIPLE|DB_MULTIPLE_KEY)) { + (void)__os_malloc(NULL, bufsize, &data.data); + data.ulen = bufsize; + data.flags |= DB_DBT_USERMEM; + } else + data.flags |= DB_DBT_MALLOC; + if (op == DB_SET_RECNO || type == DB_RECNO || type == DB_QUEUE) { - result = Tcl_GetIntFromObj(interp, - objv[objc - 1], (int *)&recno); + result = _GetUInt32(interp, objv[objc - 1], &recno); key.data = &recno; key.size = sizeof(db_recno_t); } else { - key.data = - Tcl_GetByteArrayFromObj(objv[objc - 1], &itmp); - key.size = itmp; + /* + * Some get calls (SET_*) can change the + * key pointers. So, we need to store + * the allocated key space in a tmp. + */ + ret = _CopyObjBytes(interp, objv[objc-1], + &ktmp, &key.size, &freekey); + if (ret != 0) { + result = _ReturnSetup(interp, ret, + DB_RETOK_DBCGET(ret), "dbc get"); + return (result); + } + key.data = ktmp; } - } else { + break; + default: if (i != objc) { Tcl_WrongNumArgs(interp, 2, objv, "?-args?"); result = TCL_ERROR; goto out; } key.flags |= DB_DBT_MALLOC; - data.flags |= DB_DBT_MALLOC; + if (flag & (DB_MULTIPLE|DB_MULTIPLE_KEY)) { + (void)__os_malloc(NULL, bufsize, &data.data); + data.ulen = bufsize; + data.flags |= DB_DBT_USERMEM; + } else + data.flags |= DB_DBT_MALLOC; } _debug_check(); - ret = dbc->c_get(dbc, &key, &data, flag); - result = _ReturnSetup(interp, ret, "dbc get"); + memset(&pdata, 0, sizeof(DBT)); + if (ispget) { + F_SET(&pdata, DB_DBT_MALLOC); + ret = dbc->c_pget(dbc, &key, &data, &pdata, flag); + } else + ret = dbc->c_get(dbc, &key, &data, flag); + result = _ReturnSetup(interp, ret, DB_RETOK_DBCGET(ret), "dbc get"); if (result == TCL_ERROR) goto out; retlist = Tcl_NewListObj(0, NULL); if (ret == DB_NOTFOUND) goto out1; - if ((flag & DB_OPFLAGS_MASK) == DB_GET_RECNO) { + if (op == DB_GET_RECNO) { recno = *((db_recno_t *)data.data); - myobj = Tcl_NewIntObj((int)recno); + myobj = Tcl_NewLongObj((long)recno); result = Tcl_ListObjAppendElement(interp, retlist, myobj); } else { - if ((type == DB_RECNO || type == DB_QUEUE) && key.data != NULL) - result = _SetListRecnoElem(interp, retlist, - *(db_recno_t *)key.data, data.data, data.size); - else - result = _SetListElem(interp, retlist, - key.data, key.size, data.data, data.size); + if (flag & (DB_MULTIPLE|DB_MULTIPLE_KEY)) + result = _SetMultiList(interp, + retlist, &key, &data, type, flag); + else if ((type == DB_RECNO || type == DB_QUEUE) && + key.data != NULL) { + if (ispget) + result = _Set3DBTList(interp, retlist, &key, 1, + &data, + (ptype == DB_RECNO || ptype == DB_QUEUE), + &pdata); + else + result = _SetListRecnoElem(interp, retlist, + *(db_recno_t *)key.data, + data.data, data.size); + } else { + if (ispget) + result = _Set3DBTList(interp, retlist, &key, 0, + &data, + (ptype == DB_RECNO || ptype == DB_QUEUE), + &pdata); + else + result = _SetListElem(interp, retlist, + key.data, key.size, data.data, data.size); + } } - if (key.flags & DB_DBT_MALLOC) - __os_free(key.data, key.size); - if (data.flags & DB_DBT_MALLOC) - __os_free(data.data, data.size); + if (key.data != NULL && F_ISSET(&key, DB_DBT_MALLOC)) + __os_ufree(dbc->dbp->dbenv, key.data); + if (data.data != NULL && F_ISSET(&data, DB_DBT_MALLOC)) + __os_ufree(dbc->dbp->dbenv, data.data); + if (pdata.data != NULL && F_ISSET(&pdata, DB_DBT_MALLOC)) + __os_ufree(dbc->dbp->dbenv, pdata.data); out1: if (result == TCL_OK) Tcl_SetObjResult(interp, retlist); out: + if (data.data != NULL && flag & (DB_MULTIPLE|DB_MULTIPLE_KEY)) + __os_free(dbc->dbp->dbenv, data.data); + if (freedata) + (void)__os_free(NULL, dtmp); + if (freekey) + (void)__os_free(NULL, ktmp); return (result); } @@ -642,7 +823,6 @@ tcl_DbcDup(interp, objc, objv, dbc) enum dbcdupopts { DBCDUP_POS }; - DB *thisdbp; DBC *newdbc; DBTCL_INFO *dbcip, *newdbcip, *dbip; Tcl_Obj *res; @@ -709,7 +889,6 @@ tcl_DbcDup(interp, objc, objv, dbc) result = TCL_ERROR; goto out; } - thisdbp = dbip->i_dbp; } /* * Now duplicate the cursor. If successful, we need to create @@ -731,7 +910,8 @@ tcl_DbcDup(interp, objc, objv, dbc) _SetInfoData(newdbcip, newdbc); Tcl_SetObjResult(interp, res); } else { - result = _ReturnSetup(interp, ret, "db dup"); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "db dup"); _DeleteInfo(newdbcip); } } else { diff --git a/bdb/tcl/tcl_env.c b/bdb/tcl/tcl_env.c index cb7b0d9744d..cdf4890e9fc 100644 --- a/bdb/tcl/tcl_env.c +++ b/bdb/tcl/tcl_env.c @@ -1,30 +1,33 @@ /*- * 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_env.c,v 11.33 2001/01/11 18:19:55 bostic Exp $"; +static const char revid[] = "$Id: tcl_env.c,v 11.84 2002/08/06 06:21:03 bostic Exp $"; #endif /* not lint */ #ifndef NO_SYSTEM_INCLUDES #include <sys/types.h> #include <stdlib.h> +#include <string.h> #include <tcl.h> #endif #include "db_int.h" -#include "tcl_db.h" +#include "dbinc/tcl_db.h" /* * Prototypes for procedures defined later in this file: */ -static void _EnvInfoDelete __P((Tcl_Interp *, DBTCL_INFO *)); +static void _EnvInfoDelete __P((Tcl_Interp *, DBTCL_INFO *)); +static int env_DbRemove __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *)); +static int env_DbRename __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *)); /* * PUBLIC: int env_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*)); @@ -34,86 +37,124 @@ static void _EnvInfoDelete __P((Tcl_Interp *, DBTCL_INFO *)); */ int env_Cmd(clientData, interp, objc, objv) - ClientData clientData; /* Env handle */ - Tcl_Interp *interp; /* Interpreter */ - int objc; /* How many arguments? */ - Tcl_Obj *CONST objv[]; /* The argument objects */ + ClientData clientData; /* Env handle */ + Tcl_Interp *interp; /* Interpreter */ + int objc; /* How many arguments? */ + Tcl_Obj *CONST objv[]; /* The argument objects */ { static char *envcmds[] = { - "close", +#if CONFIG_TEST + "attributes", "lock_detect", "lock_id", + "lock_id_free", + "lock_id_set", "lock_get", "lock_stat", + "lock_timeout", "lock_vec", "log_archive", "log_compare", + "log_cursor", "log_file", "log_flush", "log_get", "log_put", - "log_register", "log_stat", - "log_unregister", "mpool", "mpool_stat", "mpool_sync", "mpool_trickle", "mutex", -#if CONFIG_TEST + "rep_elect", + "rep_flush", + "rep_limit", + "rep_process_message", + "rep_request", + "rep_start", + "rep_stat", + "rpcid", "test", -#endif - "txn", "txn_checkpoint", + "txn_id_set", + "txn_recover", "txn_stat", + "txn_timeout", "verbose", +#endif + "close", + "dbremove", + "dbrename", + "txn", NULL }; enum envcmds { - ENVCLOSE, +#if CONFIG_TEST + ENVATTR, ENVLKDETECT, ENVLKID, + ENVLKFREEID, + ENVLKSETID, ENVLKGET, ENVLKSTAT, + ENVLKTIMEOUT, ENVLKVEC, ENVLOGARCH, ENVLOGCMP, + ENVLOGCURSOR, ENVLOGFILE, ENVLOGFLUSH, ENVLOGGET, ENVLOGPUT, - ENVLOGREG, ENVLOGSTAT, - ENVLOGUNREG, ENVMP, ENVMPSTAT, ENVMPSYNC, ENVTRICKLE, ENVMUTEX, -#if CONFIG_TEST + ENVREPELECT, + ENVREPFLUSH, + ENVREPLIMIT, + ENVREPPROCMESS, + ENVREPREQUEST, + ENVREPSTART, + ENVREPSTAT, + ENVRPCID, ENVTEST, -#endif - ENVTXN, ENVTXNCKP, + ENVTXNSETID, + ENVTXNRECOVER, ENVTXNSTAT, - ENVVERB + ENVTXNTIMEOUT, + ENVVERB, +#endif + ENVCLOSE, + ENVDBREMOVE, + ENVDBRENAME, + ENVTXN }; - DBTCL_INFO *envip; - DB_ENV *envp; + DBTCL_INFO *envip, *logcip; + DB_ENV *dbenv; + DB_LOGC *logc; Tcl_Obj *res; - u_int32_t newval; + char newname[MSG_SIZE]; int cmdindex, result, ret; + u_int32_t newval; +#if CONFIG_TEST + u_int32_t otherval; +#endif Tcl_ResetResult(interp); - envp = (DB_ENV *)clientData; - envip = _PtrToInfo((void *)envp); + dbenv = (DB_ENV *)clientData; + envip = _PtrToInfo((void *)dbenv); result = TCL_OK; + memset(newname, 0, MSG_SIZE); if (objc <= 1) { Tcl_WrongNumArgs(interp, 1, objv, "command cmdargs"); return (TCL_ERROR); } - if (envp == NULL) { + if (dbenv == NULL) { Tcl_SetResult(interp, "NULL env pointer", TCL_STATIC); return (TCL_ERROR); } @@ -131,33 +172,15 @@ env_Cmd(clientData, interp, objc, objv) return (IS_HELP(objv[1])); res = NULL; switch ((enum envcmds)cmdindex) { - case ENVCLOSE: - /* - * No args for this. Error if there are some. - */ - if (objc > 2) { - Tcl_WrongNumArgs(interp, 2, objv, NULL); - return (TCL_ERROR); - } - /* - * Any transactions will be aborted, and an mpools - * closed automatically. We must delete any txn - * and mp widgets we have here too for this env. - * NOTE: envip is freed when we come back from - * this function. Set it to NULL to make sure no - * one tries to use it later. - */ - _EnvInfoDelete(interp, envip); - envip = NULL; - _debug_check(); - ret = envp->close(envp, 0); - result = _ReturnSetup(interp, ret, "env close"); - break; +#if CONFIG_TEST case ENVLKDETECT: - result = tcl_LockDetect(interp, objc, objv, envp); + result = tcl_LockDetect(interp, objc, objv, dbenv); break; case ENVLKSTAT: - result = tcl_LockStat(interp, objc, objv, envp); + result = tcl_LockStat(interp, objc, objv, dbenv); + break; + case ENVLKTIMEOUT: + result = tcl_LockTimeout(interp, objc, objv, dbenv); break; case ENVLKID: /* @@ -168,73 +191,180 @@ env_Cmd(clientData, interp, objc, objv) return (TCL_ERROR); } _debug_check(); - ret = lock_id(envp, &newval); - result = _ReturnSetup(interp, ret, "lock_id"); + ret = dbenv->lock_id(dbenv, &newval); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "lock_id"); if (result == TCL_OK) - res = Tcl_NewIntObj((int)newval); + res = Tcl_NewLongObj((long)newval); + break; + case ENVLKFREEID: + if (objc != 3) { + Tcl_WrongNumArgs(interp, 3, objv, NULL); + return (TCL_ERROR); + } + result = Tcl_GetLongFromObj(interp, objv[2], (long *)&newval); + if (result != TCL_OK) + return (result); + ret = dbenv->lock_id_free(dbenv, newval); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "lock id_free"); + break; + case ENVLKSETID: + if (objc != 4) { + Tcl_WrongNumArgs(interp, 4, objv, "current max"); + return (TCL_ERROR); + } + result = Tcl_GetLongFromObj(interp, objv[2], (long *)&newval); + if (result != TCL_OK) + return (result); + result = Tcl_GetLongFromObj(interp, objv[3], (long *)&otherval); + if (result != TCL_OK) + return (result); + ret = dbenv->lock_id_set(dbenv, newval, otherval); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "lock id_free"); break; case ENVLKGET: - result = tcl_LockGet(interp, objc, objv, envp); + result = tcl_LockGet(interp, objc, objv, dbenv); break; case ENVLKVEC: - result = tcl_LockVec(interp, objc, objv, envp); + result = tcl_LockVec(interp, objc, objv, dbenv); break; case ENVLOGARCH: - result = tcl_LogArchive(interp, objc, objv, envp); + result = tcl_LogArchive(interp, objc, objv, dbenv); break; case ENVLOGCMP: result = tcl_LogCompare(interp, objc, objv); break; + case ENVLOGCURSOR: + snprintf(newname, sizeof(newname), + "%s.logc%d", envip->i_name, envip->i_envlogcid); + logcip = _NewInfo(interp, NULL, newname, I_LOGC); + if (logcip != NULL) { + ret = dbenv->log_cursor(dbenv, &logc, 0); + if (ret == 0) { + result = TCL_OK; + envip->i_envlogcid++; + /* + * We do NOT want to set i_parent to + * envip here because log cursors are + * not "tied" to the env. That is, they + * are NOT closed if the env is closed. + */ + Tcl_CreateObjCommand(interp, newname, + (Tcl_ObjCmdProc *)logc_Cmd, + (ClientData)logc, NULL); + res = + Tcl_NewStringObj(newname, strlen(newname)); + _SetInfoData(logcip, logc); + } else { + _DeleteInfo(logcip); + result = _ErrorSetup(interp, ret, "log cursor"); + } + } else { + Tcl_SetResult(interp, + "Could not set up info", TCL_STATIC); + result = TCL_ERROR; + } + break; case ENVLOGFILE: - result = tcl_LogFile(interp, objc, objv, envp); + result = tcl_LogFile(interp, objc, objv, dbenv); break; case ENVLOGFLUSH: - result = tcl_LogFlush(interp, objc, objv, envp); + result = tcl_LogFlush(interp, objc, objv, dbenv); break; case ENVLOGGET: - result = tcl_LogGet(interp, objc, objv, envp); + result = tcl_LogGet(interp, objc, objv, dbenv); break; case ENVLOGPUT: - result = tcl_LogPut(interp, objc, objv, envp); - break; - case ENVLOGREG: - result = tcl_LogRegister(interp, objc, objv, envp); - break; - case ENVLOGUNREG: - result = tcl_LogUnregister(interp, objc, objv, envp); + result = tcl_LogPut(interp, objc, objv, dbenv); break; case ENVLOGSTAT: - result = tcl_LogStat(interp, objc, objv, envp); + result = tcl_LogStat(interp, objc, objv, dbenv); break; case ENVMPSTAT: - result = tcl_MpStat(interp, objc, objv, envp); + result = tcl_MpStat(interp, objc, objv, dbenv); break; case ENVMPSYNC: - result = tcl_MpSync(interp, objc, objv, envp); + result = tcl_MpSync(interp, objc, objv, dbenv); break; case ENVTRICKLE: - result = tcl_MpTrickle(interp, objc, objv, envp); + result = tcl_MpTrickle(interp, objc, objv, dbenv); break; case ENVMP: - result = tcl_Mp(interp, objc, objv, envp, envip); + result = tcl_Mp(interp, objc, objv, dbenv, envip); + break; + case ENVREPELECT: + result = tcl_RepElect(interp, objc, objv, dbenv); + break; + case ENVREPFLUSH: + result = tcl_RepFlush(interp, objc, objv, dbenv); + break; + case ENVREPLIMIT: + result = tcl_RepLimit(interp, objc, objv, dbenv); + break; + case ENVREPPROCMESS: + result = tcl_RepProcessMessage(interp, objc, objv, dbenv); + break; + case ENVREPREQUEST: + result = tcl_RepRequest(interp, objc, objv, dbenv); + break; + case ENVREPSTART: + result = tcl_RepStart(interp, objc, objv, dbenv); + break; + case ENVREPSTAT: + result = tcl_RepStat(interp, objc, objv, dbenv); + break; + case ENVRPCID: + /* + * No args for this. Error if there are some. + */ + if (objc > 2) { + Tcl_WrongNumArgs(interp, 2, objv, NULL); + return (TCL_ERROR); + } + /* + * !!! Retrieve the client ID from the dbp handle directly. + * This is for testing purposes only. It is dbp-private data. + */ + res = Tcl_NewLongObj(dbenv->cl_id); break; case ENVTXNCKP: - result = tcl_TxnCheckpoint(interp, objc, objv, envp); + result = tcl_TxnCheckpoint(interp, objc, objv, dbenv); + break; + case ENVTXNSETID: + if (objc != 4) { + Tcl_WrongNumArgs(interp, 4, objv, "current max"); + return (TCL_ERROR); + } + result = Tcl_GetLongFromObj(interp, objv[2], (long *)&newval); + if (result != TCL_OK) + return (result); + result = Tcl_GetLongFromObj(interp, objv[3], (long *)&otherval); + if (result != TCL_OK) + return (result); + ret = dbenv->txn_id_set(dbenv, newval, otherval); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "lock id_free"); + break; + case ENVTXNRECOVER: + result = tcl_TxnRecover(interp, objc, objv, dbenv, envip); break; case ENVTXNSTAT: - result = tcl_TxnStat(interp, objc, objv, envp); + result = tcl_TxnStat(interp, objc, objv, dbenv); break; - case ENVTXN: - result = tcl_Txn(interp, objc, objv, envp, envip); + case ENVTXNTIMEOUT: + result = tcl_TxnTimeout(interp, objc, objv, dbenv); break; case ENVMUTEX: - result = tcl_Mutex(interp, objc, objv, envp, envip); + result = tcl_Mutex(interp, objc, objv, dbenv, envip); + break; + case ENVATTR: + result = tcl_EnvAttr(interp, objc, objv, dbenv); break; -#if CONFIG_TEST case ENVTEST: - result = tcl_EnvTest(interp, objc, objv, envp); + result = tcl_EnvTest(interp, objc, objv, dbenv); break; -#endif case ENVVERB: /* * Two args for this. Error if different. @@ -243,7 +373,40 @@ env_Cmd(clientData, interp, objc, objv) Tcl_WrongNumArgs(interp, 2, objv, NULL); return (TCL_ERROR); } - result = tcl_EnvVerbose(interp, envp, objv[2], objv[3]); + result = tcl_EnvVerbose(interp, dbenv, objv[2], objv[3]); + break; +#endif + case ENVCLOSE: + /* + * No args for this. Error if there are some. + */ + if (objc > 2) { + Tcl_WrongNumArgs(interp, 2, objv, NULL); + return (TCL_ERROR); + } + /* + * Any transactions will be aborted, and an mpools + * closed automatically. We must delete any txn + * and mp widgets we have here too for this env. + * NOTE: envip is freed when we come back from + * this function. Set it to NULL to make sure no + * one tries to use it later. + */ + _debug_check(); + ret = dbenv->close(dbenv, 0); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "env close"); + _EnvInfoDelete(interp, envip); + envip = NULL; + break; + case ENVDBREMOVE: + result = env_DbRemove(interp, objc, objv, dbenv); + break; + case ENVDBRENAME: + result = env_DbRename(interp, objc, objv, dbenv); + break; + case ENVTXN: + result = tcl_Txn(interp, objc, objv, dbenv, envip); break; } /* @@ -262,44 +425,56 @@ env_Cmd(clientData, interp, objc, objv) * tcl_EnvRemove -- */ int -tcl_EnvRemove(interp, objc, objv, envp, envip) +tcl_EnvRemove(interp, objc, objv, dbenv, envip) Tcl_Interp *interp; /* Interpreter */ int objc; /* How many arguments? */ Tcl_Obj *CONST objv[]; /* The argument objects */ - DB_ENV *envp; /* Env pointer */ + DB_ENV *dbenv; /* Env pointer */ DBTCL_INFO *envip; /* Info pointer */ { static char *envremopts[] = { +#if CONFIG_TEST + "-overwrite", + "-server", +#endif "-data_dir", + "-encryptaes", + "-encryptany", "-force", "-home", "-log_dir", - "-server", "-tmp_dir", "-use_environ", "-use_environ_root", NULL }; enum envremopts { +#if CONFIG_TEST + ENVREM_OVERWRITE, + ENVREM_SERVER, +#endif ENVREM_DATADIR, + ENVREM_ENCRYPT_AES, + ENVREM_ENCRYPT_ANY, ENVREM_FORCE, ENVREM_HOME, ENVREM_LOGDIR, - ENVREM_SERVER, ENVREM_TMPDIR, ENVREM_USE_ENVIRON, ENVREM_USE_ENVIRON_ROOT }; DB_ENV *e; - u_int32_t cflag, flag, forceflag; + u_int32_t cflag, enc_flag, flag, forceflag, sflag; int i, optindex, result, ret; - char *datadir, *home, *logdir, *server, *tmpdir; + char *datadir, *home, *logdir, *passwd, *server, *tmpdir; result = TCL_OK; - cflag = flag = forceflag = 0; + cflag = flag = forceflag = sflag = 0; home = NULL; + passwd = NULL; datadir = logdir = tmpdir = NULL; server = NULL; + enc_flag = 0; if (objc < 2) { Tcl_WrongNumArgs(interp, 2, objv, "?args?"); @@ -315,30 +490,59 @@ tcl_EnvRemove(interp, objc, objv, envp, envip) } i++; switch ((enum envremopts)optindex) { - case ENVREM_FORCE: - forceflag |= DB_FORCE; +#if CONFIG_TEST + case ENVREM_SERVER: + /* Make sure we have an arg to check against! */ + if (i >= objc) { + Tcl_WrongNumArgs(interp, 2, objv, + "?-server name?"); + result = TCL_ERROR; + break; + } + server = Tcl_GetStringFromObj(objv[i++], NULL); + cflag = DB_CLIENT; break; - case ENVREM_HOME: +#endif + case ENVREM_ENCRYPT_AES: /* Make sure we have an arg to check against! */ if (i >= objc) { Tcl_WrongNumArgs(interp, 2, objv, - "?-home dir?"); + "?-encryptaes passwd?"); result = TCL_ERROR; break; } - home = Tcl_GetStringFromObj(objv[i++], NULL); + passwd = Tcl_GetStringFromObj(objv[i++], NULL); + enc_flag = DB_ENCRYPT_AES; break; - case ENVREM_SERVER: + case ENVREM_ENCRYPT_ANY: /* Make sure we have an arg to check against! */ if (i >= objc) { Tcl_WrongNumArgs(interp, 2, objv, - "?-server name?"); + "?-encryptany passwd?"); result = TCL_ERROR; break; } - server = Tcl_GetStringFromObj(objv[i++], NULL); - cflag = DB_CLIENT; + passwd = Tcl_GetStringFromObj(objv[i++], NULL); + enc_flag = 0; + break; + case ENVREM_FORCE: + forceflag |= DB_FORCE; + break; + case ENVREM_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; +#if CONFIG_TEST + case ENVREM_OVERWRITE: + sflag |= DB_OVERWRITE; break; +#endif case ENVREM_USE_ENVIRON: flag |= DB_USE_ENVIRON; break; @@ -382,38 +586,56 @@ tcl_EnvRemove(interp, objc, objv, envp, envip) } /* - * If envp is NULL, we don't have an open env and we need to open + * If dbenv is NULL, we don't have an open env and we need to open * one of the user. Don't bother with the info stuff. */ - if (envp == NULL) { + if (dbenv == NULL) { if ((ret = db_env_create(&e, cflag)) != 0) { - result = _ReturnSetup(interp, ret, "db_env_create"); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "db_env_create"); goto error; } if (server != NULL) { - ret = e->set_server(e, server, 0, 0, 0); - result = _ReturnSetup(interp, ret, "set_server"); + _debug_check(); + ret = e->set_rpc_server(e, NULL, server, 0, 0, 0); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "set_rpc_server"); if (result != TCL_OK) goto error; } if (datadir != NULL) { _debug_check(); ret = e->set_data_dir(e, datadir); - result = _ReturnSetup(interp, ret, "set_data_dir"); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "set_data_dir"); if (result != TCL_OK) goto error; } if (logdir != NULL) { _debug_check(); ret = e->set_lg_dir(e, logdir); - result = _ReturnSetup(interp, ret, "set_log_dir"); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "set_log_dir"); if (result != TCL_OK) goto error; } if (tmpdir != NULL) { _debug_check(); ret = e->set_tmp_dir(e, tmpdir); - result = _ReturnSetup(interp, ret, "set_tmp_dir"); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "set_tmp_dir"); + if (result != TCL_OK) + goto error; + } + if (passwd != NULL) { + ret = e->set_encrypt(e, passwd, enc_flag); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "set_encrypt"); + } + if (sflag != 0 && (ret = e->set_flags(e, sflag, 1)) != 0) { + _debug_check(); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "set_flags"); if (result != TCL_OK) goto error; } @@ -425,7 +647,7 @@ tcl_EnvRemove(interp, objc, objv, envp, envip) */ _EnvInfoDelete(interp, envip); envip = NULL; - e = envp; + e = dbenv; } flag |= forceflag; @@ -435,7 +657,8 @@ tcl_EnvRemove(interp, objc, objv, envp, envip) */ _debug_check(); ret = e->remove(e, home, flag); - result = _ReturnSetup(interp, ret, "env remove"); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "env remove"); error: return (result); } @@ -452,7 +675,7 @@ _EnvInfoDelete(interp, envip) * any open subsystems in this env. We will: * 1. Abort any transactions (which aborts any nested txns). * 2. Close any mpools (which will put any pages itself). - * 3. Put any locks. + * 3. Put any locks and close log cursors. * 4. Close the error file. */ for (p = LIST_FIRST(&__db_infohead); p != NULL; p = nextp) { @@ -461,6 +684,11 @@ _EnvInfoDelete(interp, envip) * env. If so, remove its commands and info structure. * We do not close/abort/whatever here, because we * don't want to replicate DB behavior. + * + * NOTE: Only those types that can nest need to be + * itemized in the switch below. That is txns and mps. + * Other types like log cursors and locks will just + * get cleaned up here. */ if (p->i_parent == envip) { switch (p->i_type) { @@ -486,6 +714,7 @@ _EnvInfoDelete(interp, envip) _DeleteInfo(envip); } +#if CONFIG_TEST /* * PUBLIC: int tcl_EnvVerbose __P((Tcl_Interp *, DB_ENV *, Tcl_Obj *, * PUBLIC: Tcl_Obj *)); @@ -493,9 +722,9 @@ _EnvInfoDelete(interp, envip) * tcl_EnvVerbose -- */ int -tcl_EnvVerbose(interp, envp, which, onoff) +tcl_EnvVerbose(interp, dbenv, which, onoff) Tcl_Interp *interp; /* Interpreter */ - DB_ENV *envp; /* Env pointer */ + DB_ENV *dbenv; /* Env pointer */ Tcl_Obj *which; /* Which subsystem */ Tcl_Obj *onoff; /* On or off */ { @@ -503,6 +732,7 @@ tcl_EnvVerbose(interp, envp, which, onoff) "chkpt", "deadlock", "recovery", + "rep", "wait", NULL }; @@ -510,6 +740,7 @@ tcl_EnvVerbose(interp, envp, which, onoff) ENVVERB_CHK, ENVVERB_DEAD, ENVVERB_REC, + ENVVERB_REP, ENVVERB_WAIT }; static char *verbonoff[] = { @@ -538,6 +769,9 @@ tcl_EnvVerbose(interp, envp, which, onoff) case ENVVERB_REC: wh = DB_VERB_RECOVERY; break; + case ENVVERB_REP: + wh = DB_VERB_REPLICATION; + break; case ENVVERB_WAIT: wh = DB_VERB_WAITSFOR; break; @@ -557,22 +791,107 @@ tcl_EnvVerbose(interp, envp, which, onoff) default: return (TCL_ERROR); } - ret = envp->set_verbose(envp, wh, on); - return (_ReturnSetup(interp, ret, "env set verbose")); + ret = dbenv->set_verbose(dbenv, wh, on); + return (_ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "env set verbose")); } +#endif #if CONFIG_TEST /* + * PUBLIC: int tcl_EnvAttr __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *)); + * + * tcl_EnvAttr -- + * Return a list of the env's attributes + */ +int +tcl_EnvAttr(interp, objc, objv, dbenv) + Tcl_Interp *interp; /* Interpreter */ + int objc; /* How many arguments? */ + Tcl_Obj *CONST objv[]; /* The argument objects */ + DB_ENV *dbenv; /* Env pointer */ +{ + int result; + Tcl_Obj *myobj, *retlist; + + result = TCL_OK; + + if (objc > 2) { + Tcl_WrongNumArgs(interp, 2, objv, NULL); + return (TCL_ERROR); + } + retlist = Tcl_NewListObj(0, NULL); + /* + * XXX + * We peek at the dbenv to determine what subsystems + * we have available in this env. + */ + myobj = Tcl_NewStringObj("-home", strlen("-home")); + if ((result = Tcl_ListObjAppendElement(interp, + retlist, myobj)) != TCL_OK) + goto err; + myobj = Tcl_NewStringObj(dbenv->db_home, strlen(dbenv->db_home)); + if ((result = Tcl_ListObjAppendElement(interp, + retlist, myobj)) != TCL_OK) + goto err; + if (CDB_LOCKING(dbenv)) { + myobj = Tcl_NewStringObj("-cdb", strlen("-cdb")); + if ((result = Tcl_ListObjAppendElement(interp, + retlist, myobj)) != TCL_OK) + goto err; + } + if (CRYPTO_ON(dbenv)) { + myobj = Tcl_NewStringObj("-crypto", strlen("-crypto")); + if ((result = Tcl_ListObjAppendElement(interp, + retlist, myobj)) != TCL_OK) + goto err; + } + if (LOCKING_ON(dbenv)) { + myobj = Tcl_NewStringObj("-lock", strlen("-lock")); + if ((result = Tcl_ListObjAppendElement(interp, + retlist, myobj)) != TCL_OK) + goto err; + } + if (LOGGING_ON(dbenv)) { + myobj = Tcl_NewStringObj("-log", strlen("-log")); + if ((result = Tcl_ListObjAppendElement(interp, + retlist, myobj)) != TCL_OK) + goto err; + } + if (MPOOL_ON(dbenv)) { + myobj = Tcl_NewStringObj("-mpool", strlen("-mpool")); + if ((result = Tcl_ListObjAppendElement(interp, + retlist, myobj)) != TCL_OK) + goto err; + } + if (RPC_ON(dbenv)) { + myobj = Tcl_NewStringObj("-rpc", strlen("-rpc")); + if ((result = Tcl_ListObjAppendElement(interp, + retlist, myobj)) != TCL_OK) + goto err; + } + if (TXN_ON(dbenv)) { + myobj = Tcl_NewStringObj("-txn", strlen("-txn")); + if ((result = Tcl_ListObjAppendElement(interp, + retlist, myobj)) != TCL_OK) + goto err; + } + Tcl_SetObjResult(interp, retlist); +err: + return (result); +} + +/* * PUBLIC: int tcl_EnvTest __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *)); * * tcl_EnvTest -- */ int -tcl_EnvTest(interp, objc, objv, envp) +tcl_EnvTest(interp, objc, objv, dbenv) Tcl_Interp *interp; /* Interpreter */ int objc; /* How many arguments? */ Tcl_Obj *CONST objv[]; /* The argument objects */ - DB_ENV *envp; /* Env pointer */ + DB_ENV *dbenv; /* Env pointer */ { static char *envtestcmd[] = { "abort", @@ -584,29 +903,44 @@ tcl_EnvTest(interp, objc, objv, envp) ENVTEST_COPY }; static char *envtestat[] = { + "electinit", + "electsend", + "electvote1", + "electvote2", + "electwait1", + "electwait2", "none", + "predestroy", "preopen", - "prerename", + "postdestroy", "postlog", "postlogmeta", "postopen", - "postrename", "postsync", + "subdb_lock", NULL }; enum envtestat { + ENVTEST_ELECTINIT, + ENVTEST_ELECTSEND, + ENVTEST_ELECTVOTE1, + ENVTEST_ELECTVOTE2, + ENVTEST_ELECTWAIT1, + ENVTEST_ELECTWAIT2, ENVTEST_NONE, + ENVTEST_PREDESTROY, ENVTEST_PREOPEN, - ENVTEST_PRERENAME, + ENVTEST_POSTDESTROY, ENVTEST_POSTLOG, ENVTEST_POSTLOGMETA, ENVTEST_POSTOPEN, - ENVTEST_POSTRENAME, - ENVTEST_POSTSYNC + ENVTEST_POSTSYNC, + ENVTEST_SUBDB_LOCKS }; int *loc, optindex, result, testval; result = TCL_OK; + loc = NULL; if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "abort|copy location"); @@ -623,10 +957,10 @@ tcl_EnvTest(interp, objc, objv, envp) } switch ((enum envtestcmd)optindex) { case ENVTEST_ABORT: - loc = &envp->test_abort; + loc = &dbenv->test_abort; break; case ENVTEST_COPY: - loc = &envp->test_copy; + loc = &dbenv->test_copy; break; default: Tcl_SetResult(interp, "Illegal store location", TCL_STATIC); @@ -642,14 +976,38 @@ tcl_EnvTest(interp, objc, objv, envp) return (result); } switch ((enum envtestat)optindex) { + case ENVTEST_ELECTINIT: + DB_ASSERT(loc == &dbenv->test_abort); + testval = DB_TEST_ELECTINIT; + break; + case ENVTEST_ELECTSEND: + DB_ASSERT(loc == &dbenv->test_abort); + testval = DB_TEST_ELECTSEND; + break; + case ENVTEST_ELECTVOTE1: + DB_ASSERT(loc == &dbenv->test_abort); + testval = DB_TEST_ELECTVOTE1; + break; + case ENVTEST_ELECTVOTE2: + DB_ASSERT(loc == &dbenv->test_abort); + testval = DB_TEST_ELECTVOTE2; + break; + case ENVTEST_ELECTWAIT1: + DB_ASSERT(loc == &dbenv->test_abort); + testval = DB_TEST_ELECTWAIT1; + break; + case ENVTEST_ELECTWAIT2: + DB_ASSERT(loc == &dbenv->test_abort); + testval = DB_TEST_ELECTWAIT2; + break; case ENVTEST_NONE: testval = 0; break; case ENVTEST_PREOPEN: testval = DB_TEST_PREOPEN; break; - case ENVTEST_PRERENAME: - testval = DB_TEST_PRERENAME; + case ENVTEST_PREDESTROY: + testval = DB_TEST_PREDESTROY; break; case ENVTEST_POSTLOG: testval = DB_TEST_POSTLOG; @@ -660,12 +1018,16 @@ tcl_EnvTest(interp, objc, objv, envp) case ENVTEST_POSTOPEN: testval = DB_TEST_POSTOPEN; break; - case ENVTEST_POSTRENAME: - testval = DB_TEST_POSTRENAME; + case ENVTEST_POSTDESTROY: + testval = DB_TEST_POSTDESTROY; break; case ENVTEST_POSTSYNC: testval = DB_TEST_POSTSYNC; break; + case ENVTEST_SUBDB_LOCKS: + DB_ASSERT(loc == &dbenv->test_abort); + testval = DB_TEST_SUBDB_LOCKS; + break; default: Tcl_SetResult(interp, "Illegal test location", TCL_STATIC); return (TCL_ERROR); @@ -676,3 +1038,273 @@ tcl_EnvTest(interp, objc, objv, envp) return (result); } #endif + +/* + * env_DbRemove -- + * Implements the ENV->dbremove command. + */ +static int +env_DbRemove(interp, objc, objv, dbenv) + Tcl_Interp *interp; /* Interpreter */ + int objc; /* How many arguments? */ + Tcl_Obj *CONST objv[]; /* The argument objects */ + DB_ENV *dbenv; +{ + static char *envdbrem[] = { + "-auto_commit", + "-txn", + "--", + NULL + }; + enum envdbrem { + TCL_EDBREM_COMMIT, + TCL_EDBREM_TXN, + TCL_EDBREM_ENDARG + }; + DB_TXN *txn; + u_int32_t flag; + int endarg, i, optindex, result, ret, subdblen; + u_char *subdbtmp; + char *arg, *db, *subdb, msg[MSG_SIZE]; + + txn = NULL; + result = TCL_OK; + subdbtmp = NULL; + db = subdb = NULL; + endarg = 0; + flag = 0; + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 2, objv, "?args? filename ?database?"); + return (TCL_ERROR); + } + + /* + * We must first parse for the environment flag, since that + * is needed for db_create. Then create the db handle. + */ + i = 2; + while (i < objc) { + if (Tcl_GetIndexFromObj(interp, objv[i], envdbrem, + "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 envdbrem)optindex) { + case TCL_EDBREM_COMMIT: + flag |= DB_AUTO_COMMIT; + break; + case TCL_EDBREM_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, + "env dbremove: Invalid txn %s\n", arg); + Tcl_SetResult(interp, msg, TCL_VOLATILE); + return (TCL_ERROR); + } + break; + case TCL_EDBREM_ENDARG: + endarg = 1; + break; + } + /* + * If, at any time, parsing the args we get an error, + * bail out and return. + */ + if (result != TCL_OK) + goto error; + if (endarg) + break; + } + if (result != TCL_OK) + goto error; + /* + * Any args we have left, (better be 1 or 2 left) are + * file names. If there is 1, a db name, if 2 a db and subdb name. + */ + if ((i != (objc - 1)) || (i != (objc - 2))) { + /* + * Dbs must be NULL terminated file names, but subdbs can + * be anything. Use Strings for the db name and byte + * arrays for the subdb. + */ + db = Tcl_GetStringFromObj(objv[i++], NULL); + if (i != objc) { + subdbtmp = + Tcl_GetByteArrayFromObj(objv[i++], &subdblen); + if ((ret = __os_malloc(dbenv, subdblen + 1, + &subdb)) != 0) { + Tcl_SetResult(interp, + db_strerror(ret), TCL_STATIC); + return (0); + } + memcpy(subdb, subdbtmp, subdblen); + subdb[subdblen] = '\0'; + } + } else { + Tcl_WrongNumArgs(interp, 2, objv, "?args? filename ?database?"); + result = TCL_ERROR; + goto error; + } + ret = dbenv->dbremove(dbenv, txn, db, subdb, flag); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "env dbremove"); +error: + if (subdb) + __os_free(dbenv, subdb); + return (result); +} + +/* + * env_DbRename -- + * Implements the ENV->dbrename command. + */ +static int +env_DbRename(interp, objc, objv, dbenv) + Tcl_Interp *interp; /* Interpreter */ + int objc; /* How many arguments? */ + Tcl_Obj *CONST objv[]; /* The argument objects */ + DB_ENV *dbenv; +{ + static char *envdbmv[] = { + "-auto_commit", + "-txn", + "--", + NULL + }; + enum envdbmv { + TCL_EDBMV_COMMIT, + TCL_EDBMV_TXN, + TCL_EDBMV_ENDARG + }; + DB_TXN *txn; + u_int32_t flag; + int endarg, i, newlen, optindex, result, ret, subdblen; + u_char *subdbtmp; + char *arg, *db, *newname, *subdb, msg[MSG_SIZE]; + + txn = NULL; + result = TCL_OK; + subdbtmp = NULL; + db = newname = subdb = NULL; + endarg = 0; + flag = 0; + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 3, objv, + "?args? filename ?database? ?newname?"); + return (TCL_ERROR); + } + + /* + * We must first parse for the environment flag, since that + * is needed for db_create. Then create the db handle. + */ + i = 2; + while (i < objc) { + if (Tcl_GetIndexFromObj(interp, objv[i], envdbmv, + "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 envdbmv)optindex) { + case TCL_EDBMV_COMMIT: + flag |= DB_AUTO_COMMIT; + break; + case TCL_EDBMV_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, + "env dbrename: Invalid txn %s\n", arg); + Tcl_SetResult(interp, msg, TCL_VOLATILE); + return (TCL_ERROR); + } + break; + case TCL_EDBMV_ENDARG: + endarg = 1; + break; + } + /* + * If, at any time, parsing the args we get an error, + * bail out and return. + */ + if (result != TCL_OK) + goto error; + if (endarg) + break; + } + if (result != TCL_OK) + goto error; + /* + * Any args we have left, (better be 2 or 3 left) are + * file names. If there is 2, a db name, if 3 a db and subdb name. + */ + if ((i != (objc - 2)) || (i != (objc - 3))) { + /* + * Dbs must be NULL terminated file names, but subdbs can + * be anything. Use Strings for the db name and byte + * arrays for the subdb. + */ + db = Tcl_GetStringFromObj(objv[i++], NULL); + if (i == objc - 2) { + subdbtmp = + Tcl_GetByteArrayFromObj(objv[i++], &subdblen); + if ((ret = __os_malloc(dbenv, subdblen + 1, + &subdb)) != 0) { + Tcl_SetResult(interp, + db_strerror(ret), TCL_STATIC); + return (0); + } + memcpy(subdb, subdbtmp, subdblen); + subdb[subdblen] = '\0'; + } + subdbtmp = + Tcl_GetByteArrayFromObj(objv[i++], &newlen); + if ((ret = __os_malloc(dbenv, newlen + 1, + &newname)) != 0) { + Tcl_SetResult(interp, + db_strerror(ret), TCL_STATIC); + return (0); + } + memcpy(newname, subdbtmp, newlen); + newname[newlen] = '\0'; + } else { + Tcl_WrongNumArgs(interp, 3, objv, + "?args? filename ?database? ?newname?"); + result = TCL_ERROR; + goto error; + } + ret = dbenv->dbrename(dbenv, txn, db, subdb, newname, flag); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "env dbrename"); +error: + if (subdb) + __os_free(dbenv, subdb); + if (newname) + __os_free(dbenv, newname); + return (result); +} diff --git a/bdb/tcl/tcl_internal.c b/bdb/tcl/tcl_internal.c index bdab60f4ad6..2d6ad4df444 100644 --- a/bdb/tcl/tcl_internal.c +++ b/bdb/tcl/tcl_internal.c @@ -1,14 +1,14 @@ /*- * See the file LICENSE for redistribution information. * - * Copyright (c) 1999, 2000 + * Copyright (c) 1999-2001 * Sleepycat Software. All rights reserved. */ #include "db_config.h" #ifndef lint -static const char revid[] = "$Id: tcl_internal.c,v 11.27 2000/05/22 18:36:51 sue Exp $"; +static const char revid[] = "$Id: tcl_internal.c,v 11.54 2002/08/15 02:47:46 bostic Exp $"; #endif /* not lint */ #ifndef NO_SYSTEM_INCLUDES @@ -20,10 +20,10 @@ static const char revid[] = "$Id: tcl_internal.c,v 11.27 2000/05/22 18:36:51 sue #endif #include "db_int.h" -#include "tcl_db.h" -#include "db_page.h" -#include "db_am.h" -#include "db_ext.h" +#include "dbinc/tcl_db.h" +#include "dbinc/db_page.h" +#include "dbinc/db_am.h" +#include "dbinc_auto/db_ext.h" /* * @@ -46,6 +46,16 @@ static const char revid[] = "$Id: tcl_internal.c,v 11.27 2000/05/22 18:36:51 sue /* * Prototypes for procedures defined later in this file: */ +static void tcl_flag_callback __P((u_int32_t, const FN *, void *)); + +/* + * Private structure type used to pass both an interp and an object into + * a callback's single void *. + */ +struct __tcl_callback_bundle { + Tcl_Interp *interp; + Tcl_Obj *obj; +}; #define GLOB_CHAR(c) ((c) == '*' || (c) == '?') @@ -68,14 +78,14 @@ _NewInfo(interp, anyp, name, type) DBTCL_INFO *p; int i, ret; - if ((ret = __os_malloc(NULL, sizeof(DBTCL_INFO), NULL, &p)) != 0) { + if ((ret = __os_malloc(NULL, sizeof(DBTCL_INFO), &p)) != 0) { Tcl_SetResult(interp, db_strerror(ret), TCL_STATIC); return (NULL); } if ((ret = __os_strdup(NULL, name, &p->i_name)) != 0) { Tcl_SetResult(interp, db_strerror(ret), TCL_STATIC); - __os_free(p, sizeof(DBTCL_INFO)); + __os_free(NULL, p); return (NULL); } p->i_interp = interp; @@ -87,6 +97,12 @@ _NewInfo(interp, anyp, name, type) p->i_err = NULL; p->i_errpfx = NULL; p->i_lockobj.data = NULL; + p->i_btcompare = NULL; + p->i_dupcompare = NULL; + p->i_hashproc = NULL; + p->i_second_call = NULL; + p->i_rep_eid = NULL; + p->i_rep_send = NULL; for (i = 0; i < MAX_ID; i++) p->i_otherid[i] = 0; @@ -111,22 +127,6 @@ _NameToPtr(name) } /* - * PUBLIC: char *_PtrToName __P((CONST void *)); - */ -char * -_PtrToName(ptr) - CONST void *ptr; -{ - DBTCL_INFO *p; - - for (p = LIST_FIRST(&__db_infohead); p != NULL; - p = LIST_NEXT(p, entries)) - if (p->i_anyp == ptr) - return (p->i_name); - return (NULL); -} - -/* * PUBLIC: DBTCL_INFO *_PtrToInfo __P((CONST void *)); */ DBTCL_INFO * @@ -183,15 +183,27 @@ _DeleteInfo(p) return; LIST_REMOVE(p, entries); if (p->i_lockobj.data != NULL) - __os_free(p->i_lockobj.data, p->i_lockobj.size); + __os_free(NULL, p->i_lockobj.data); if (p->i_err != NULL) { fclose(p->i_err); p->i_err = NULL; } if (p->i_errpfx != NULL) - __os_freestr(p->i_errpfx); - __os_freestr(p->i_name); - __os_free(p, sizeof(DBTCL_INFO)); + __os_free(NULL, p->i_errpfx); + if (p->i_btcompare != NULL) + Tcl_DecrRefCount(p->i_btcompare); + if (p->i_dupcompare != NULL) + Tcl_DecrRefCount(p->i_dupcompare); + if (p->i_hashproc != NULL) + Tcl_DecrRefCount(p->i_hashproc); + if (p->i_second_call != NULL) + Tcl_DecrRefCount(p->i_second_call); + if (p->i_rep_eid != NULL) + Tcl_DecrRefCount(p->i_rep_eid); + if (p->i_rep_send != NULL) + Tcl_DecrRefCount(p->i_rep_send); + __os_free(NULL, p->i_name); + __os_free(NULL, p); return; } @@ -258,7 +270,7 @@ _SetListRecnoElem(interp, list, elem1, elem2, e2size) int myobjc; myobjc = 2; - myobjv[0] = Tcl_NewIntObj(elem1); + myobjv[0] = Tcl_NewLongObj((long)elem1); myobjv[1] = Tcl_NewByteArrayObj(elem2, e2size); thislist = Tcl_NewListObj(myobjc, myobjv); if (thislist == NULL) @@ -268,6 +280,107 @@ _SetListRecnoElem(interp, list, elem1, elem2, e2size) } /* + * _Set3DBTList -- + * This is really analogous to both _SetListElem and + * _SetListRecnoElem--it's used for three-DBT lists returned by + * DB->pget and DBC->pget(). We'd need a family of four functions + * to handle all the recno/non-recno cases, however, so we make + * this a little more aware of the internals and do the logic inside. + * + * XXX + * One of these days all these functions should probably be cleaned up + * to eliminate redundancy and bring them into the standard DB + * function namespace. + * + * PUBLIC: int _Set3DBTList __P((Tcl_Interp *, Tcl_Obj *, DBT *, int, + * PUBLIC: DBT *, int, DBT *)); + */ +int +_Set3DBTList(interp, list, elem1, is1recno, elem2, is2recno, elem3) + Tcl_Interp *interp; + Tcl_Obj *list; + DBT *elem1, *elem2, *elem3; + int is1recno, is2recno; +{ + + Tcl_Obj *myobjv[3], *thislist; + + if (is1recno) + myobjv[0] = Tcl_NewLongObj((long)*(db_recno_t *)elem1->data); + else + myobjv[0] = + Tcl_NewByteArrayObj((u_char *)elem1->data, elem1->size); + + if (is2recno) + myobjv[1] = Tcl_NewLongObj((long)*(db_recno_t *)elem2->data); + else + myobjv[1] = + Tcl_NewByteArrayObj((u_char *)elem2->data, elem2->size); + + myobjv[2] = Tcl_NewByteArrayObj((u_char *)elem3->data, elem3->size); + + thislist = Tcl_NewListObj(3, myobjv); + + if (thislist == NULL) + return (TCL_ERROR); + return (Tcl_ListObjAppendElement(interp, list, thislist)); +} + +/* + * _SetMultiList -- build a list for return from multiple get. + * + * PUBLIC: int _SetMultiList __P((Tcl_Interp *, + * PUBLIC: Tcl_Obj *, DBT *, DBT*, int, int)); + */ +int +_SetMultiList(interp, list, key, data, type, flag) + Tcl_Interp *interp; + Tcl_Obj *list; + DBT *key, *data; + int type, flag; +{ + db_recno_t recno; + u_int32_t dlen, klen; + int result; + void *pointer, *dp, *kp; + + recno = 0; + dlen = 0; + kp = NULL; + + DB_MULTIPLE_INIT(pointer, data); + result = TCL_OK; + + if (type == DB_RECNO || type == DB_QUEUE) + recno = *(db_recno_t *) key->data; + else + kp = key->data; + klen = key->size; + do { + if (flag & DB_MULTIPLE_KEY) { + if (type == DB_RECNO || type == DB_QUEUE) + DB_MULTIPLE_RECNO_NEXT(pointer, + data, recno, dp, dlen); + else + DB_MULTIPLE_KEY_NEXT(pointer, + data, kp, klen, dp, dlen); + } else + DB_MULTIPLE_NEXT(pointer, data, dp, dlen); + + if (pointer == NULL) + break; + + if (type == DB_RECNO || type == DB_QUEUE) { + result = + _SetListRecnoElem(interp, list, recno, dp, dlen); + recno++; + } else + result = _SetListElem(interp, list, kp, klen, dp, dlen); + } while (result == TCL_OK); + + return (result); +} +/* * PUBLIC: int _GetGlobPrefix __P((char *, char **)); */ int @@ -299,12 +412,12 @@ _GetGlobPrefix(pattern, prefix) } /* - * PUBLIC: int _ReturnSetup __P((Tcl_Interp *, int, char *)); + * PUBLIC: int _ReturnSetup __P((Tcl_Interp *, int, int, char *)); */ int -_ReturnSetup(interp, ret, errmsg) +_ReturnSetup(interp, ret, ok, errmsg) Tcl_Interp *interp; - int ret; + int ret, ok; char *errmsg; { char *msg; @@ -327,12 +440,9 @@ _ReturnSetup(interp, ret, errmsg) msg = db_strerror(ret); Tcl_AppendResult(interp, msg, NULL); - switch (ret) { - case DB_NOTFOUND: - case DB_KEYEXIST: - case DB_KEYEMPTY: + if (ok) return (TCL_OK); - default: + else { Tcl_SetErrorCode(interp, "BerkeleyDB", msg, NULL); return (TCL_ERROR); } @@ -375,7 +485,7 @@ _ErrorFunc(pfx, msg) * If we cannot allocate enough to put together the prefix * and message then give them just the message. */ - if (__os_malloc(NULL, size, NULL, &err) != 0) { + if (__os_malloc(NULL, size, &err) != 0) { Tcl_AddErrorInfo(interp, msg); Tcl_AppendResult(interp, msg, "\n", NULL); return; @@ -383,7 +493,7 @@ _ErrorFunc(pfx, msg) snprintf(err, size, "%s: %s", pfx, msg); Tcl_AddErrorInfo(interp, err); Tcl_AppendResult(interp, err, "\n", NULL); - __os_free(err, size); + __os_free(NULL, err); return; } @@ -399,8 +509,9 @@ _GetLsn(interp, obj, lsn) DB_LSN *lsn; { Tcl_Obj **myobjv; - int itmp, myobjc, result; char msg[MSG_SIZE]; + int myobjc, result; + u_int32_t tmp; result = Tcl_ListObjGetElements(interp, obj, &myobjc, &myobjv); if (result == TCL_ERROR) @@ -411,15 +522,125 @@ _GetLsn(interp, obj, lsn) Tcl_SetResult(interp, msg, TCL_VOLATILE); return (result); } - result = Tcl_GetIntFromObj(interp, myobjv[0], &itmp); + result = _GetUInt32(interp, myobjv[0], &tmp); if (result == TCL_ERROR) return (result); - lsn->file = itmp; - result = Tcl_GetIntFromObj(interp, myobjv[1], &itmp); - lsn->offset = itmp; + lsn->file = tmp; + result = _GetUInt32(interp, myobjv[1], &tmp); + lsn->offset = tmp; return (result); } +/* + * _GetUInt32 -- + * Get a u_int32_t from a Tcl object. Tcl_GetIntFromObj does the + * right thing most of the time, but on machines where a long is 8 bytes + * and an int is 4 bytes, it errors on integers between the maximum + * int32_t and the maximum u_int32_t. This is correct, but we generally + * want a u_int32_t in the end anyway, so we use Tcl_GetLongFromObj and do + * the bounds checking ourselves. + * + * This code looks much like Tcl_GetIntFromObj, only with a different + * bounds check. It's essentially Tcl_GetUnsignedIntFromObj, which + * unfortunately doesn't exist. + * + * PUBLIC: int _GetUInt32 __P((Tcl_Interp *, Tcl_Obj *, u_int32_t *)); + */ +int +_GetUInt32(interp, obj, resp) + Tcl_Interp *interp; + Tcl_Obj *obj; + u_int32_t *resp; +{ + int result; + long ltmp; + + result = Tcl_GetLongFromObj(interp, obj, <mp); + if (result != TCL_OK) + return (result); + + if ((unsigned long)ltmp != (u_int32_t)ltmp) { + if (interp != NULL) { + Tcl_ResetResult(interp); + Tcl_AppendToObj(Tcl_GetObjResult(interp), + "integer value too large for u_int32_t", -1); + } + return (TCL_ERROR); + } + + *resp = (u_int32_t)ltmp; + return (TCL_OK); +} + +/* + * tcl_flag_callback -- + * Callback for db_pr.c functions that contain the FN struct mapping + * flag values to meaningful strings. This function appends a Tcl_Obj + * containing each pertinent flag string to the specified Tcl list. + */ +static void +tcl_flag_callback(flags, fn, vtcbp) + u_int32_t flags; + const FN *fn; + void *vtcbp; +{ + const FN *fnp; + Tcl_Interp *interp; + Tcl_Obj *newobj, *listobj; + int result; + struct __tcl_callback_bundle *tcbp; + + tcbp = (struct __tcl_callback_bundle *)vtcbp; + interp = tcbp->interp; + listobj = tcbp->obj; + + for (fnp = fn; fnp->mask != 0; ++fnp) + if (LF_ISSET(fnp->mask)) { + newobj = Tcl_NewStringObj(fnp->name, strlen(fnp->name)); + result = + Tcl_ListObjAppendElement(interp, listobj, newobj); + + /* + * Tcl_ListObjAppendElement is defined to return TCL_OK + * unless listobj isn't actually a list (or convertible + * into one). If this is the case, we screwed up badly + * somehow. + */ + DB_ASSERT(result == TCL_OK); + } +} + +/* + * _GetFlagsList -- + * Get a new Tcl object, containing a list of the string values + * associated with a particular set of flag values, given a function + * that can extract the right names for the right flags. + * + * PUBLIC: Tcl_Obj *_GetFlagsList __P((Tcl_Interp *, u_int32_t, + * PUBLIC: void (*)(u_int32_t, void *, + * PUBLIC: void (*)(u_int32_t, const FN *, void *)))); + */ +Tcl_Obj * +_GetFlagsList(interp, flags, func) + Tcl_Interp *interp; + u_int32_t flags; + void (*func) + __P((u_int32_t, void *, void (*)(u_int32_t, const FN *, void *))); +{ + Tcl_Obj *newlist; + struct __tcl_callback_bundle tcb; + + newlist = Tcl_NewObj(); + + memset(&tcb, 0, sizeof(tcb)); + tcb.interp = interp; + tcb.obj = newlist; + + func(flags, &tcb, tcl_flag_callback); + + return (newlist); +} + int __debug_stop, __debug_on, __debug_print, __debug_test; /* @@ -432,9 +653,65 @@ _debug_check() return; if (__debug_print != 0) { - printf("\r%6d:", __debug_on); + printf("\r%7d:", __debug_on); fflush(stdout); } if (__debug_on++ == __debug_test || __debug_stop) __db_loadme(); } + +/* + * XXX + * Tcl 8.1+ Tcl_GetByteArrayFromObj/Tcl_GetIntFromObj bug. + * + * There is a bug in Tcl 8.1+ and byte arrays in that if it happens + * to use an object as both a byte array and something else like + * an int, and you've done a Tcl_GetByteArrayFromObj, then you + * do a Tcl_GetIntFromObj, your memory is deleted. + * + * Workaround is for all byte arrays we want to use, if it can be + * represented as an integer, we copy it so that we don't lose the + * memory. + */ +/* + * PUBLIC: int _CopyObjBytes __P((Tcl_Interp *, Tcl_Obj *obj, void **, + * PUBLIC: u_int32_t *, int *)); + */ +int +_CopyObjBytes(interp, obj, newp, sizep, freep) + Tcl_Interp *interp; + Tcl_Obj *obj; + void **newp; + u_int32_t *sizep; + int *freep; +{ + void *tmp, *new; + int i, len, ret; + + /* + * If the object is not an int, then just return the byte + * array because it won't be transformed out from under us. + * If it is a number, we need to copy it. + */ + *freep = 0; + ret = Tcl_GetIntFromObj(interp, obj, &i); + tmp = Tcl_GetByteArrayFromObj(obj, &len); + *sizep = len; + if (ret == TCL_ERROR) { + Tcl_ResetResult(interp); + *newp = tmp; + return (0); + } + + /* + * If we get here, we have an integer that might be reused + * at some other point so we cannot count on GetByteArray + * keeping our pointer valid. + */ + if ((ret = __os_malloc(NULL, len, &new)) != 0) + return (ret); + memcpy(new, tmp, len); + *newp = new; + *freep = 1; + return (0); +} diff --git a/bdb/tcl/tcl_lock.c b/bdb/tcl/tcl_lock.c index 89f6eeb2b39..6cb96dbb0da 100644 --- a/bdb/tcl/tcl_lock.c +++ b/bdb/tcl/tcl_lock.c @@ -1,14 +1,14 @@ /*- * See the file LICENSE for redistribution information. * - * Copyright (c) 1999, 2000 + * Copyright (c) 1999-2001 * Sleepycat Software. All rights reserved. */ #include "db_config.h" #ifndef lint -static const char revid[] = "$Id: tcl_lock.c,v 11.21 2001/01/11 18:19:55 bostic Exp $"; +static const char revid[] = "$Id: tcl_lock.c,v 11.47 2002/08/08 15:27:10 bostic Exp $"; #endif /* not lint */ #ifndef NO_SYSTEM_INCLUDES @@ -20,7 +20,7 @@ static const char revid[] = "$Id: tcl_lock.c,v 11.21 2001/01/11 18:19:55 bostic #endif #include "db_int.h" -#include "tcl_db.h" +#include "dbinc/tcl_db.h" /* * Prototypes for procedures defined later in this file: @@ -31,15 +31,23 @@ static int _GetThisLock __P((Tcl_Interp *, DB_ENV *, u_int32_t, u_int32_t, DBT *, db_lockmode_t, char *)); static void _LockPutInfo __P((Tcl_Interp *, db_lockop_t, DB_LOCK *, u_int32_t, DBT *)); - +#if CONFIG_TEST static char *lkmode[] = { - "ng", "read", "write", - "iwrite", "iread", "iwr", + "ng", + "read", + "write", + "iwrite", + "iread", + "iwr", NULL }; enum lkmode { - LK_NG, LK_READ, LK_WRITE, - LK_IWRITE, LK_IREAD, LK_IWR + LK_NG, + LK_READ, + LK_WRITE, + LK_IWRITE, + LK_IREAD, + LK_IWR }; /* @@ -56,16 +64,22 @@ tcl_LockDetect(interp, objc, objv, envp) DB_ENV *envp; /* Environment pointer */ { static char *ldopts[] = { - "-lock_conflict", + "expire", "default", + "maxlocks", + "minlocks", + "minwrites", "oldest", "random", "youngest", NULL }; enum ldopts { - LD_CONFLICT, + LD_EXPIRE, LD_DEFAULT, + LD_MAXLOCKS, + LD_MINLOCKS, + LD_MINWRITES, LD_OLDEST, LD_RANDOM, LD_YOUNGEST @@ -82,10 +96,26 @@ tcl_LockDetect(interp, objc, objv, envp) return (IS_HELP(objv[i])); i++; switch ((enum ldopts)optindex) { + case LD_EXPIRE: + FLAG_CHECK(policy); + policy = DB_LOCK_EXPIRE; + break; case LD_DEFAULT: FLAG_CHECK(policy); policy = DB_LOCK_DEFAULT; break; + case LD_MAXLOCKS: + FLAG_CHECK(policy); + policy = DB_LOCK_MAXLOCKS; + break; + case LD_MINWRITES: + FLAG_CHECK(policy); + policy = DB_LOCK_MINWRITE; + break; + case LD_MINLOCKS: + FLAG_CHECK(policy); + policy = DB_LOCK_MINLOCKS; + break; case LD_OLDEST: FLAG_CHECK(policy); policy = DB_LOCK_OLDEST; @@ -98,15 +128,12 @@ tcl_LockDetect(interp, objc, objv, envp) FLAG_CHECK(policy); policy = DB_LOCK_RANDOM; break; - case LD_CONFLICT: - flag |= DB_LOCK_CONFLICT; - break; } } _debug_check(); - ret = lock_detect(envp, flag, policy, NULL); - result = _ReturnSetup(interp, ret, "lock detect"); + ret = envp->lock_detect(envp, flag, policy, NULL); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "lock detect"); return (result); } @@ -132,12 +159,14 @@ tcl_LockGet(interp, objc, objv, envp) }; DBT obj; Tcl_Obj *res; + void *otmp; db_lockmode_t mode; u_int32_t flag, lockid; - int itmp, optindex, result; + int freeobj, optindex, result, ret; char newname[MSG_SIZE]; result = TCL_OK; + freeobj = 0; memset(newname, 0, MSG_SIZE); if (objc != 5 && objc != 6) { Tcl_WrongNumArgs(interp, 2, objv, "?-nowait? mode id obj"); @@ -152,28 +181,19 @@ tcl_LockGet(interp, objc, objv, envp) memset(&obj, 0, sizeof(obj)); if ((result = - Tcl_GetIntFromObj(interp, objv[objc-2], &itmp)) != TCL_OK) + _GetUInt32(interp, objv[objc-2], &lockid)) != TCL_OK) return (result); - lockid = itmp; - /* - * XXX - * Tcl 8.1 Tcl_GetByteArrayFromObj/Tcl_GetIntFromObj bug. - * - * The line below was originally before the Tcl_GetIntFromObj. - * - * There is a bug in Tcl 8.1 and byte arrays in that if it happens - * to use an object as both a byte array and something else like - * an int, and you've done a Tcl_GetByteArrayFromObj, then you - * do a Tcl_GetIntFromObj, your memory is deleted. - * - * Workaround is to make sure all Tcl_GetByteArrayFromObj calls - * are done last. - */ - obj.data = Tcl_GetByteArrayFromObj(objv[objc-1], &itmp); - obj.size = itmp; - if ((result = _LockMode(interp, objv[(objc - 3)], &mode)) != TCL_OK) + ret = _CopyObjBytes(interp, objv[objc-1], &otmp, + &obj.size, &freeobj); + if (ret != 0) { + result = _ReturnSetup(interp, ret, + DB_RETOK_STD(ret), "lock get"); return (result); + } + obj.data = otmp; + if ((result = _LockMode(interp, objv[(objc - 3)], &mode)) != TCL_OK) + goto out; /* * Any left over arg is the flag. @@ -195,6 +215,9 @@ tcl_LockGet(interp, objc, objv, envp) res = Tcl_NewStringObj(newname, strlen(newname)); Tcl_SetObjResult(interp, res); } +out: + if (freeobj) + (void)__os_free(envp, otmp); return (result); } @@ -224,8 +247,8 @@ tcl_LockStat(interp, objc, objv, envp) return (TCL_ERROR); } _debug_check(); - ret = lock_stat(envp, &sp, NULL); - result = _ReturnSetup(interp, ret, "lock stat"); + ret = envp->lock_stat(envp, &sp, 0); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "lock stat"); if (result == TCL_ERROR) return (result); /* @@ -237,9 +260,11 @@ tcl_LockStat(interp, objc, objv, envp) * MAKE_STAT_LIST assumes 'res' and 'error' label. */ MAKE_STAT_LIST("Region size", sp->st_regsize); - MAKE_STAT_LIST("Max locks", sp->st_maxlocks); - MAKE_STAT_LIST("Max lockers", sp->st_maxlockers); - MAKE_STAT_LIST("Max objects", sp->st_maxobjects); + MAKE_STAT_LIST("Last allocated locker ID", sp->st_id); + MAKE_STAT_LIST("Current maximum unused locker ID", sp->st_cur_maxid); + MAKE_STAT_LIST("Maximum locks", sp->st_maxlocks); + MAKE_STAT_LIST("Maximum lockers", sp->st_maxlockers); + MAKE_STAT_LIST("Maximum objects", sp->st_maxobjects); MAKE_STAT_LIST("Lock modes", sp->st_nmodes); MAKE_STAT_LIST("Current number of locks", sp->st_nlocks); MAKE_STAT_LIST("Maximum number of locks so far", sp->st_maxnlocks); @@ -250,12 +275,49 @@ tcl_LockStat(interp, objc, objv, envp) MAKE_STAT_LIST("Number of conflicts", sp->st_nconflicts); MAKE_STAT_LIST("Lock requests", sp->st_nrequests); MAKE_STAT_LIST("Lock releases", sp->st_nreleases); + MAKE_STAT_LIST("Lock requests that would have waited", sp->st_nnowaits); MAKE_STAT_LIST("Deadlocks detected", sp->st_ndeadlocks); MAKE_STAT_LIST("Number of region lock waits", sp->st_region_wait); MAKE_STAT_LIST("Number of region lock nowaits", sp->st_region_nowait); + MAKE_STAT_LIST("Lock timeout value", sp->st_locktimeout); + MAKE_STAT_LIST("Number of lock timeouts", sp->st_nlocktimeouts); + MAKE_STAT_LIST("Transaction timeout value", sp->st_txntimeout); + MAKE_STAT_LIST("Number of transaction timeouts", sp->st_ntxntimeouts); Tcl_SetObjResult(interp, res); error: - __os_free(sp, sizeof(*sp)); + free(sp); + return (result); +} + +/* + * tcl_LockTimeout -- + * + * PUBLIC: int tcl_LockTimeout __P((Tcl_Interp *, int, + * PUBLIC: Tcl_Obj * CONST*, DB_ENV *)); + */ +int +tcl_LockTimeout(interp, objc, objv, envp) + Tcl_Interp *interp; /* Interpreter */ + int objc; /* How many arguments? */ + Tcl_Obj *CONST objv[]; /* The argument objects */ + DB_ENV *envp; /* Environment pointer */ +{ + long timeout; + int result, ret; + + /* + * One arg, the timeout. + */ + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "?timeout?"); + return (TCL_ERROR); + } + result = Tcl_GetLongFromObj(interp, objv[2], &timeout); + if (result != TCL_OK) + return (result); + _debug_check(); + ret = envp->set_timeout(envp, (u_int32_t)timeout, DB_SET_LOCK_TIMEOUT); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "lock timeout"); return (result); } @@ -265,10 +327,10 @@ error: */ static int lock_Cmd(clientData, interp, objc, objv) - ClientData clientData; /* Lock handle */ - Tcl_Interp *interp; /* Interpreter */ - int objc; /* How many arguments? */ - Tcl_Obj *CONST objv[]; /* The argument objects */ + ClientData clientData; /* Lock handle */ + Tcl_Interp *interp; /* Interpreter */ + int objc; /* How many arguments? */ + Tcl_Obj *CONST objv[]; /* The argument objects */ { static char *lkcmds[] = { "put", @@ -315,11 +377,12 @@ lock_Cmd(clientData, interp, objc, objv) switch ((enum lkcmds)cmdindex) { case LKPUT: _debug_check(); - ret = lock_put(env, lock); - result = _ReturnSetup(interp, ret, "lock put"); + ret = env->lock_put(env, lock); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "lock put"); (void)Tcl_DeleteCommand(interp, lkip->i_name); _DeleteInfo(lkip); - __os_free(lock, sizeof(DB_LOCK)); + __os_free(env, lock); break; } return (result); @@ -332,9 +395,9 @@ lock_Cmd(clientData, interp, objc, objv) */ int tcl_LockVec(interp, objc, objv, envp) - Tcl_Interp *interp; /* Interpreter */ - int objc; /* How many arguments? */ - Tcl_Obj *CONST objv[]; /* The argument objects */ + Tcl_Interp *interp; /* Interpreter */ + int objc; /* How many arguments? */ + Tcl_Obj *CONST objv[]; /* The argument objects */ DB_ENV *envp; /* environment pointer */ { static char *lvopts[] = { @@ -345,25 +408,34 @@ tcl_LockVec(interp, objc, objv, envp) LVNOWAIT }; static char *lkops[] = { - "get", "put", "put_all", "put_obj", + "get", + "put", + "put_all", + "put_obj", + "timeout", NULL }; enum lkops { - LKGET, LKPUT, LKPUTALL, LKPUTOBJ + LKGET, + LKPUT, + LKPUTALL, + LKPUTOBJ, + LKTIMEOUT }; DB_LOCK *lock; DB_LOCKREQ list; DBT obj; Tcl_Obj **myobjv, *res, *thisop; - db_lockmode_t mode; + void *otmp; u_int32_t flag, lockid; - int i, itmp, myobjc, optindex, result, ret; + int freeobj, i, myobjc, optindex, result, ret; char *lockname, msg[MSG_SIZE], newname[MSG_SIZE]; result = TCL_OK; memset(newname, 0, MSG_SIZE); flag = 0; - mode = 0; + freeobj = 0; + /* * If -nowait is given, it MUST be first arg. */ @@ -385,10 +457,9 @@ tcl_LockVec(interp, objc, objv, envp) /* * Our next arg MUST be the locker ID. */ - result = Tcl_GetIntFromObj(interp, objv[i++], &itmp); + result = _GetUInt32(interp, objv[i++], &lockid); if (result != TCL_OK) return (result); - lockid = itmp; /* * All other remaining args are operation tuples. @@ -429,26 +500,19 @@ tcl_LockVec(interp, objc, objv, envp) result = _LockMode(interp, myobjv[2], &list.mode); if (result != TCL_OK) goto error; - /* - * XXX - * Tcl 8.1 Tcl_GetByteArrayFromObj/Tcl_GetIntFromObj - * bug. - * - * There is a bug in Tcl 8.1 and byte arrays in that if - * it happens to use an object as both a byte array and - * something else like an int, and you've done a - * Tcl_GetByteArrayFromObj, then you do a - * Tcl_GetIntFromObj, your memory is deleted. - * - * Workaround is to make sure all - * Tcl_GetByteArrayFromObj calls are done last. - */ - obj.data = Tcl_GetByteArrayFromObj(myobjv[1], &itmp); - obj.size = itmp; + ret = _CopyObjBytes(interp, myobjv[1], &otmp, + &obj.size, &freeobj); + if (ret != 0) { + result = _ReturnSetup(interp, ret, + DB_RETOK_STD(ret), "lock vec"); + return (result); + } + obj.data = otmp; ret = _GetThisLock(interp, envp, lockid, flag, &obj, list.mode, newname); if (ret != 0) { - result = _ReturnSetup(interp, ret, "lock vec"); + result = _ReturnSetup(interp, ret, + DB_RETOK_STD(ret), "lock vec"); thisop = Tcl_NewIntObj(ret); (void)Tcl_ListObjAppendElement(interp, res, thisop); @@ -456,6 +520,10 @@ tcl_LockVec(interp, objc, objv, envp) } thisop = Tcl_NewStringObj(newname, strlen(newname)); (void)Tcl_ListObjAppendElement(interp, res, thisop); + if (freeobj) { + (void)__os_free(envp, otmp); + freeobj = 0; + } continue; case LKPUT: if (myobjc != 2) { @@ -493,17 +561,27 @@ tcl_LockVec(interp, objc, objv, envp) goto error; } list.op = DB_LOCK_PUT_OBJ; - obj.data = Tcl_GetByteArrayFromObj(myobjv[1], &itmp); - obj.size = itmp; + ret = _CopyObjBytes(interp, myobjv[1], &otmp, + &obj.size, &freeobj); + if (ret != 0) { + result = _ReturnSetup(interp, ret, + DB_RETOK_STD(ret), "lock vec"); + return (result); + } + obj.data = otmp; list.obj = &obj; break; + case LKTIMEOUT: + list.op = DB_LOCK_TIMEOUT; + break; + } /* * We get here, we have set up our request, now call * lock_vec. */ _debug_check(); - ret = lock_vec(envp, lockid, flag, &list, 1, NULL); + ret = envp->lock_vec(envp, lockid, flag, &list, 1, NULL); /* * Now deal with whether or not the operation succeeded. * Get's were done above, all these are only puts. @@ -511,7 +589,12 @@ tcl_LockVec(interp, objc, objv, envp) thisop = Tcl_NewIntObj(ret); result = Tcl_ListObjAppendElement(interp, res, thisop); if (ret != 0 && result == TCL_OK) - result = _ReturnSetup(interp, ret, "lock put"); + result = _ReturnSetup(interp, ret, + DB_RETOK_STD(ret), "lock put"); + if (freeobj) { + (void)__os_free(envp, otmp); + freeobj = 0; + } /* * We did a put of some kind. Since we did that, * we have to delete the commands associated with @@ -581,7 +664,7 @@ _LockPutInfo(interp, op, lock, lockid, objp) found = 1; if (found) { (void)Tcl_DeleteCommand(interp, p->i_name); - __os_free(p->i_lock, sizeof(DB_LOCK)); + __os_free(NULL, p->i_lock); _DeleteInfo(p); } } @@ -615,16 +698,16 @@ _GetThisLock(interp, envp, lockid, flag, objp, mode, newname) TCL_STATIC); return (TCL_ERROR); } - ret = __os_malloc(envp, sizeof(DB_LOCK), NULL, &lock); + ret = __os_malloc(envp, sizeof(DB_LOCK), &lock); if (ret != 0) { Tcl_SetResult(interp, db_strerror(ret), TCL_STATIC); return (TCL_ERROR); } _debug_check(); - ret = lock_get(envp, lockid, flag, objp, mode, lock); - result = _ReturnSetup(interp, ret, "lock get"); + ret = envp->lock_get(envp, lockid, flag, objp, mode, lock); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "lock get"); if (result == TCL_ERROR) { - __os_free(lock, sizeof(DB_LOCK)); + __os_free(envp, lock); _DeleteInfo(ip); return (result); } @@ -632,12 +715,12 @@ _GetThisLock(interp, envp, lockid, flag, objp, mode, newname) * Success. Set up return. Set up new info * and command widget for this lock. */ - ret = __os_malloc(envp, objp->size, NULL, &ip->i_lockobj.data); + ret = __os_malloc(envp, objp->size, &ip->i_lockobj.data); if (ret != 0) { Tcl_SetResult(interp, "Could not duplicate obj", TCL_STATIC); - (void)lock_put(envp, lock); - __os_free(lock, sizeof(DB_LOCK)); + (void)envp->lock_put(envp, lock); + __os_free(envp, lock); _DeleteInfo(ip); result = TCL_ERROR; goto error; @@ -653,3 +736,4 @@ _GetThisLock(interp, envp, lockid, flag, objp, mode, newname) error: return (result); } +#endif diff --git a/bdb/tcl/tcl_log.c b/bdb/tcl/tcl_log.c index 20f8e8c0277..be6eebfb013 100644 --- a/bdb/tcl/tcl_log.c +++ b/bdb/tcl/tcl_log.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_log.c,v 11.21 2000/11/30 00:58:45 ubell Exp $"; +static const char revid[] = "$Id: tcl_log.c,v 11.52 2002/08/14 20:11:57 bostic Exp $"; #endif /* not lint */ #ifndef NO_SYSTEM_INCLUDES @@ -20,7 +20,12 @@ static const char revid[] = "$Id: tcl_log.c,v 11.21 2000/11/30 00:58:45 ubell Ex #endif #include "db_int.h" -#include "tcl_db.h" +#include "dbinc/log.h" +#include "dbinc/tcl_db.h" +#include "dbinc/txn.h" + +#ifdef CONFIG_TEST +static int tcl_LogcGet __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_LOGC *)); /* * tcl_LogArchive -- @@ -73,8 +78,8 @@ tcl_LogArchive(interp, objc, objv, envp) } _debug_check(); list = NULL; - ret = log_archive(envp, &list, flag, NULL); - result = _ReturnSetup(interp, ret, "log archive"); + ret = envp->log_archive(envp, &list, flag); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "log archive"); if (result == TCL_OK) { res = Tcl_NewListObj(0, NULL); for (file = list; file != NULL && *file != NULL; file++) { @@ -86,7 +91,7 @@ tcl_LogArchive(interp, objc, objv, envp) Tcl_SetObjResult(interp, res); } if (list != NULL) - __os_free(list, 0); + __os_ufree(envp, list); return (result); } @@ -166,24 +171,24 @@ tcl_LogFile(interp, objc, objv, envp) name = NULL; while (ret == ENOMEM) { if (name != NULL) - __os_free(name, len/2); - ret = __os_malloc(envp, len, NULL, &name); + __os_free(envp, name); + ret = __os_malloc(envp, len, &name); if (ret != 0) { Tcl_SetResult(interp, db_strerror(ret), TCL_STATIC); break; } _debug_check(); - ret = log_file(envp, &lsn, name, len); + ret = envp->log_file(envp, &lsn, name, len); len *= 2; } - result = _ReturnSetup(interp, ret, "log_file"); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "log_file"); if (ret == 0) { res = Tcl_NewStringObj(name, strlen(name)); Tcl_SetObjResult(interp, res); } if (name != NULL) - __os_free(name, len/2); + __os_free(envp, name); return (result); } @@ -222,8 +227,8 @@ tcl_LogFlush(interp, objc, objv, envp) lsnp = NULL; _debug_check(); - ret = log_flush(envp, lsnp); - result = _ReturnSetup(interp, ret, "log_flush"); + ret = envp->log_flush(envp, lsnp); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "log_flush"); return (result); } @@ -240,111 +245,13 @@ tcl_LogGet(interp, objc, objv, envp) Tcl_Obj *CONST objv[]; /* The argument objects */ DB_ENV *envp; /* Environment pointer */ { - static char *loggetopts[] = { - "-checkpoint", "-current", "-first", - "-last", "-next", "-prev", - "-set", - NULL - }; - enum loggetopts { - LOGGET_CKP, LOGGET_CUR, LOGGET_FIRST, - LOGGET_LAST, LOGGET_NEXT, LOGGET_PREV, - LOGGET_SET - }; - DB_LSN lsn; - DBT data; - Tcl_Obj *dataobj, *lsnlist, *myobjv[2], *res; - u_int32_t flag; - int i, myobjc, optindex, result, ret; - - result = TCL_OK; - flag = 0; - if (objc < 3) { - Tcl_WrongNumArgs(interp, 2, objv, "?-args? lsn"); - return (TCL_ERROR); - } - - /* - * Get the command name index from the object based on the options - * defined above. - */ - i = 2; - while (i < objc) { - if (Tcl_GetIndexFromObj(interp, objv[i], - loggetopts, "option", TCL_EXACT, &optindex) != TCL_OK) - return (IS_HELP(objv[i])); - i++; - switch ((enum loggetopts)optindex) { - case LOGGET_CKP: - FLAG_CHECK(flag); - flag |= DB_CHECKPOINT; - break; - case LOGGET_CUR: - FLAG_CHECK(flag); - flag |= DB_CURRENT; - break; - case LOGGET_FIRST: - FLAG_CHECK(flag); - flag |= DB_FIRST; - break; - case LOGGET_LAST: - FLAG_CHECK(flag); - flag |= DB_LAST; - break; - case LOGGET_NEXT: - FLAG_CHECK(flag); - flag |= DB_NEXT; - break; - case LOGGET_PREV: - FLAG_CHECK(flag); - flag |= DB_PREV; - break; - case LOGGET_SET: - FLAG_CHECK(flag); - flag |= DB_SET; - if (i == objc) { - Tcl_WrongNumArgs(interp, 2, objv, "?-set lsn?"); - result = TCL_ERROR; - break; - } - result = _GetLsn(interp, objv[i++], &lsn); - break; - } - } - if (result == TCL_ERROR) - return (result); - - memset(&data, 0, sizeof(data)); - data.flags |= DB_DBT_MALLOC; - _debug_check(); - ret = log_get(envp, &lsn, &data, flag); - res = Tcl_NewListObj(0, NULL); - result = _ReturnSetup(interp, ret, "log_get"); - if (ret == 0) { - /* - * Success. Set up return list as {LSN data} where LSN - * is a sublist {file offset}. - */ - myobjc = 2; - myobjv[0] = Tcl_NewIntObj(lsn.file); - myobjv[1] = Tcl_NewIntObj(lsn.offset); - lsnlist = Tcl_NewListObj(myobjc, myobjv); - if (lsnlist == NULL) { - if (data.data != NULL) - __os_free(data.data, data.size); - return (TCL_ERROR); - } - result = Tcl_ListObjAppendElement(interp, res, lsnlist); - dataobj = Tcl_NewStringObj(data.data, data.size); - result = Tcl_ListObjAppendElement(interp, res, dataobj); - } - if (data.data != NULL) - __os_free(data.data, data.size); + COMPQUIET(objv, NULL); + COMPQUIET(objc, 0); + COMPQUIET(envp, NULL); - if (result == TCL_OK) - Tcl_SetObjResult(interp, res); - return (result); + Tcl_SetResult(interp, "FAIL: log_get deprecated\n", TCL_STATIC); + return (TCL_ERROR); } /* @@ -361,20 +268,22 @@ tcl_LogPut(interp, objc, objv, envp) DB_ENV *envp; /* Environment pointer */ { static char *logputopts[] = { - "-checkpoint", "-curlsn", "-flush", + "-flush", NULL }; enum logputopts { - LOGPUT_CKP, LOGPUT_CUR, LOGPUT_FLUSH + LOGPUT_FLUSH }; DB_LSN lsn; DBT data; Tcl_Obj *intobj, *res; + void *dtmp; u_int32_t flag; - int itmp, optindex, result, ret; + int freedata, optindex, result, ret; result = TCL_OK; flag = 0; + freedata = 0; if (objc < 3) { Tcl_WrongNumArgs(interp, 2, objv, "?-args? record"); return (TCL_ERROR); @@ -384,8 +293,14 @@ tcl_LogPut(interp, objc, objv, envp) * Data/record must be the last arg. */ memset(&data, 0, sizeof(data)); - data.data = Tcl_GetByteArrayFromObj(objv[objc-1], &itmp); - data.size = itmp; + ret = _CopyObjBytes(interp, objv[objc-1], &dtmp, + &data.size, &freedata); + if (ret != 0) { + result = _ReturnSetup(interp, ret, + DB_RETOK_STD(ret), "log put"); + return (result); + } + data.data = dtmp; /* * Get the command name index from the object based on the options @@ -397,12 +312,6 @@ tcl_LogPut(interp, objc, objv, envp) return (IS_HELP(objv[2])); } switch ((enum logputopts)optindex) { - case LOGPUT_CKP: - flag = DB_CHECKPOINT; - break; - case LOGPUT_CUR: - flag = DB_CURLSN; - break; case LOGPUT_FLUSH: flag = DB_FLUSH; break; @@ -413,69 +322,20 @@ tcl_LogPut(interp, objc, objv, envp) return (result); _debug_check(); - ret = log_put(envp, &lsn, &data, flag); - result = _ReturnSetup(interp, ret, "log_put"); + ret = envp->log_put(envp, &lsn, &data, flag); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "log_put"); if (result == TCL_ERROR) return (result); res = Tcl_NewListObj(0, NULL); - intobj = Tcl_NewIntObj(lsn.file); + intobj = Tcl_NewLongObj((long)lsn.file); result = Tcl_ListObjAppendElement(interp, res, intobj); - intobj = Tcl_NewIntObj(lsn.offset); + intobj = Tcl_NewLongObj((long)lsn.offset); result = Tcl_ListObjAppendElement(interp, res, intobj); Tcl_SetObjResult(interp, res); + if (freedata) + (void)__os_free(NULL, dtmp); return (result); } - -/* - * tcl_LogRegister -- - * - * PUBLIC: int tcl_LogRegister __P((Tcl_Interp *, int, - * PUBLIC: Tcl_Obj * CONST*, DB_ENV *)); - */ -int -tcl_LogRegister(interp, objc, objv, envp) - Tcl_Interp *interp; /* Interpreter */ - int objc; /* How many arguments? */ - Tcl_Obj *CONST objv[]; /* The argument objects */ - DB_ENV *envp; /* Environment pointer */ -{ - DB *dbp; - Tcl_Obj *res; - int result, ret; - char *arg, msg[MSG_SIZE]; - - result = TCL_OK; - if (objc != 4) { - Tcl_WrongNumArgs(interp, 2, objv, "db filename"); - return (TCL_ERROR); - } - /* - * First comes the DB. - */ - arg = Tcl_GetStringFromObj(objv[2], NULL); - dbp = NAME_TO_DB(arg); - if (dbp == NULL) { - snprintf(msg, MSG_SIZE, - "LogRegister: Invalid db: %s\n", arg); - Tcl_SetResult(interp, msg, TCL_VOLATILE); - return (TCL_ERROR); - } - - /* - * Next is the filename. - */ - arg = Tcl_GetStringFromObj(objv[3], NULL); - - _debug_check(); - ret = log_register(envp, dbp, arg); - result = _ReturnSetup(interp, ret, "log_register"); - if (result == TCL_OK) { - res = Tcl_NewIntObj((int)dbp->log_fileid); - Tcl_SetObjResult(interp, res); - } - return (result); -} - /* * tcl_LogStat -- * @@ -502,8 +362,8 @@ tcl_LogStat(interp, objc, objv, envp) return (TCL_ERROR); } _debug_check(); - ret = log_stat(envp, &sp, NULL); - result = _ReturnSetup(interp, ret, "log stat"); + ret = envp->log_stat(envp, &sp, 0); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "log stat"); if (result == TCL_ERROR) return (result); @@ -520,7 +380,7 @@ tcl_LogStat(interp, objc, objv, envp) MAKE_STAT_LIST("Region size", sp->st_regsize); MAKE_STAT_LIST("Log file mode", sp->st_mode); MAKE_STAT_LIST("Log record cache size", sp->st_lg_bsize); - MAKE_STAT_LIST("Maximum log file size", sp->st_lg_max); + MAKE_STAT_LIST("Current log file size", sp->st_lg_size); MAKE_STAT_LIST("Mbytes written", sp->st_w_mbytes); MAKE_STAT_LIST("Bytes written (over Mb)", sp->st_w_bytes); MAKE_STAT_LIST("Mbytes written since checkpoint", sp->st_wc_mbytes); @@ -532,50 +392,219 @@ tcl_LogStat(interp, objc, objv, envp) MAKE_STAT_LIST("Times log flushed", sp->st_scount); MAKE_STAT_LIST("Current log file number", sp->st_cur_file); MAKE_STAT_LIST("Current log file offset", sp->st_cur_offset); + MAKE_STAT_LIST("On-disk log file number", sp->st_disk_file); + MAKE_STAT_LIST("On-disk log file offset", sp->st_disk_offset); + MAKE_STAT_LIST("Max commits in a log flush", sp->st_maxcommitperflush); + MAKE_STAT_LIST("Min commits in a log flush", sp->st_mincommitperflush); MAKE_STAT_LIST("Number of region lock waits", sp->st_region_wait); MAKE_STAT_LIST("Number of region lock nowaits", sp->st_region_nowait); Tcl_SetObjResult(interp, res); error: - __os_free(sp, sizeof(*sp)); + free(sp); return (result); } /* - * tcl_LogUnregister -- + * logc_Cmd -- + * Implements the log cursor command. * - * PUBLIC: int tcl_LogUnregister __P((Tcl_Interp *, int, - * PUBLIC: Tcl_Obj * CONST*, DB_ENV *)); + * PUBLIC: int logc_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*)); */ int -tcl_LogUnregister(interp, objc, objv, envp) +logc_Cmd(clientData, interp, objc, objv) + ClientData clientData; /* Cursor handle */ Tcl_Interp *interp; /* Interpreter */ int objc; /* How many arguments? */ Tcl_Obj *CONST objv[]; /* The argument objects */ - DB_ENV *envp; /* Environment pointer */ { - DB *dbp; - char *arg, msg[MSG_SIZE]; - int result, ret; + static char *logccmds[] = { + "close", + "get", + NULL + }; + enum logccmds { + LOGCCLOSE, + LOGCGET + }; + DB_LOGC *logc; + DBTCL_INFO *logcip; + int cmdindex, result, ret; + Tcl_ResetResult(interp); + logc = (DB_LOGC *)clientData; + logcip = _PtrToInfo((void *)logc); result = TCL_OK; + + if (objc <= 1) { + Tcl_WrongNumArgs(interp, 1, objv, "command cmdargs"); + return (TCL_ERROR); + } + if (logc == NULL) { + Tcl_SetResult(interp, "NULL logc pointer", TCL_STATIC); + return (TCL_ERROR); + } + if (logcip == NULL) { + Tcl_SetResult(interp, "NULL logc info pointer", TCL_STATIC); + return (TCL_ERROR); + } + /* - * 1 arg for this. Error if more or less. + * Get the command name index from the object based on the berkdbcmds + * defined above. */ - if (objc != 3) { - Tcl_WrongNumArgs(interp, 2, objv, NULL); - return (TCL_ERROR); + if (Tcl_GetIndexFromObj(interp, objv[1], logccmds, "command", + TCL_EXACT, &cmdindex) != TCL_OK) + return (IS_HELP(objv[1])); + switch ((enum logccmds)cmdindex) { + case LOGCCLOSE: + /* + * No args for this. Error if there are some. + */ + if (objc > 2) { + Tcl_WrongNumArgs(interp, 2, objv, NULL); + return (TCL_ERROR); + } + _debug_check(); + ret = logc->close(logc, 0); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "logc close"); + if (result == TCL_OK) { + (void)Tcl_DeleteCommand(interp, logcip->i_name); + _DeleteInfo(logcip); + } + break; + case LOGCGET: + result = tcl_LogcGet(interp, objc, objv, logc); + break; } - arg = Tcl_GetStringFromObj(objv[2], NULL); - dbp = NAME_TO_DB(arg); - if (dbp == NULL) { - snprintf(msg, MSG_SIZE, - "log_unregister: Invalid db identifier: %s\n", arg); - Tcl_SetResult(interp, msg, TCL_VOLATILE); + return (result); +} + +static int +tcl_LogcGet(interp, objc, objv, logc) + Tcl_Interp *interp; + int objc; + Tcl_Obj * CONST *objv; + DB_LOGC *logc; +{ + static char *logcgetopts[] = { + "-current", + "-first", + "-last", + "-next", + "-prev", + "-set", + NULL + }; + enum logcgetopts { + LOGCGET_CURRENT, + LOGCGET_FIRST, + LOGCGET_LAST, + LOGCGET_NEXT, + LOGCGET_PREV, + LOGCGET_SET + }; + DB_LSN lsn; + DBT data; + Tcl_Obj *dataobj, *lsnlist, *myobjv[2], *res; + u_int32_t flag; + int i, myobjc, optindex, result, ret; + + result = TCL_OK; + res = NULL; + flag = 0; + + if (objc < 3) { + Tcl_WrongNumArgs(interp, 2, objv, "?-args? lsn"); return (TCL_ERROR); } + + /* + * Get the command name index from the object based on the options + * defined above. + */ + i = 2; + while (i < objc) { + if (Tcl_GetIndexFromObj(interp, objv[i], + logcgetopts, "option", TCL_EXACT, &optindex) != TCL_OK) + return (IS_HELP(objv[i])); + i++; + switch ((enum logcgetopts)optindex) { + case LOGCGET_CURRENT: + FLAG_CHECK(flag); + flag |= DB_CURRENT; + break; + case LOGCGET_FIRST: + FLAG_CHECK(flag); + flag |= DB_FIRST; + break; + case LOGCGET_LAST: + FLAG_CHECK(flag); + flag |= DB_LAST; + break; + case LOGCGET_NEXT: + FLAG_CHECK(flag); + flag |= DB_NEXT; + break; + case LOGCGET_PREV: + FLAG_CHECK(flag); + flag |= DB_PREV; + break; + case LOGCGET_SET: + FLAG_CHECK(flag); + flag |= DB_SET; + if (i == objc) { + Tcl_WrongNumArgs(interp, 2, objv, "?-set lsn?"); + result = TCL_ERROR; + break; + } + result = _GetLsn(interp, objv[i++], &lsn); + break; + } + } + + if (result == TCL_ERROR) + return (result); + + memset(&data, 0, sizeof(data)); + _debug_check(); - ret = log_unregister(envp, dbp); - result = _ReturnSetup(interp, ret, "log_unregister"); + ret = logc->get(logc, &lsn, &data, flag); + + res = Tcl_NewListObj(0, NULL); + if (res == NULL) + goto memerr; + + if (ret == 0) { + /* + * Success. Set up return list as {LSN data} where LSN + * is a sublist {file offset}. + */ + myobjc = 2; + myobjv[0] = Tcl_NewLongObj((long)lsn.file); + myobjv[1] = Tcl_NewLongObj((long)lsn.offset); + lsnlist = Tcl_NewListObj(myobjc, myobjv); + if (lsnlist == NULL) + goto memerr; + + result = Tcl_ListObjAppendElement(interp, res, lsnlist); + dataobj = Tcl_NewStringObj(data.data, data.size); + if (dataobj == NULL) { + goto memerr; + } + result = Tcl_ListObjAppendElement(interp, res, dataobj); + } else + result = _ReturnSetup(interp, ret, DB_RETOK_LGGET(ret), + "DB_LOGC->get"); + + Tcl_SetObjResult(interp, res); + + if (0) { +memerr: if (res != NULL) + Tcl_DecrRefCount(res); + Tcl_SetResult(interp, "allocation failed", TCL_STATIC); + } return (result); } +#endif diff --git a/bdb/tcl/tcl_mp.c b/bdb/tcl/tcl_mp.c index b424deea242..0c4411cb58a 100644 --- a/bdb/tcl/tcl_mp.c +++ b/bdb/tcl/tcl_mp.c @@ -1,14 +1,14 @@ /*- * See the file LICENSE for redistribution information. * - * Copyright (c) 1999, 2000 + * Copyright (c) 1999-2001 * Sleepycat Software. All rights reserved. */ #include "db_config.h" #ifndef lint -static const char revid[] = "$Id: tcl_mp.c,v 11.24 2001/01/09 16:13:59 sue Exp $"; +static const char revid[] = "$Id: tcl_mp.c,v 11.39 2002/08/06 06:21:27 bostic Exp $"; #endif /* not lint */ #ifndef NO_SYSTEM_INCLUDES @@ -20,7 +20,7 @@ static const char revid[] = "$Id: tcl_mp.c,v 11.24 2001/01/09 16:13:59 sue Exp $ #endif #include "db_int.h" -#include "tcl_db.h" +#include "dbinc/tcl_db.h" /* * Prototypes for procedures defined later in this file: @@ -45,7 +45,7 @@ static int tcl_PgIsset __P((Tcl_Interp *, int, Tcl_Obj * CONST*, */ void _MpInfoDelete(interp, mpip) - Tcl_Interp *interp; /* Interpreter */ + Tcl_Interp *interp; /* Interpreter */ DBTCL_INFO *mpip; /* Info for mp */ { DBTCL_INFO *nextp, *p; @@ -63,6 +63,7 @@ _MpInfoDelete(interp, mpip) } } +#if CONFIG_TEST /* * tcl_MpSync -- * @@ -76,25 +77,28 @@ tcl_MpSync(interp, objc, objv, envp) DB_ENV *envp; /* Environment pointer */ { - DB_LSN lsn; + DB_LSN lsn, *lsnp; int result, ret; result = TCL_OK; + lsnp = NULL; /* * No flags, must be 3 args. */ - if (objc != 3) { + if (objc == 3) { + result = _GetLsn(interp, objv[2], &lsn); + if (result == TCL_ERROR) + return (result); + lsnp = &lsn; + } + else if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, "lsn"); return (TCL_ERROR); } - result = _GetLsn(interp, objv[2], &lsn); - if (result == TCL_ERROR) - return (result); - _debug_check(); - ret = memp_sync(envp, &lsn); - result = _ReturnSetup(interp, ret, "memp sync"); + ret = envp->memp_sync(envp, lsnp); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "memp sync"); return (result); } @@ -132,8 +136,8 @@ tcl_MpTrickle(interp, objc, objv, envp) return (result); _debug_check(); - ret = memp_trickle(envp, percent, &pages); - result = _ReturnSetup(interp, ret, "memp trickle"); + ret = envp->memp_trickle(envp, percent, &pages); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "memp trickle"); if (result == TCL_ERROR) return (result); @@ -264,29 +268,39 @@ tcl_Mp(interp, objc, objv, envp, envip) TCL_STATIC); return (TCL_ERROR); } + + _debug_check(); + if ((ret = envp->memp_fcreate(envp, &mpf, 0)) != 0) { + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "mpool"); + _DeleteInfo(ip); + goto error; + } + /* - * XXX finfop is NULL here. Interface currently doesn't - * have all the stuff. Should expand interface. + * XXX + * Interface doesn't currently support DB_MPOOLFILE configuration. */ - _debug_check(); - ret = memp_fopen(envp, file, flag, mode, (size_t)pgsize, NULL, &mpf); - if (ret != 0) { - result = _ReturnSetup(interp, ret, "mpool"); + if ((ret = mpf->open(mpf, file, flag, mode, (size_t)pgsize)) != 0) { + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "mpool"); _DeleteInfo(ip); - } else { - /* - * Success. Set up return. Set up new info - * and command widget for this mpool. - */ - envip->i_envmpid++; - ip->i_parent = envip; - ip->i_pgsz = pgsize; - _SetInfoData(ip, mpf); - Tcl_CreateObjCommand(interp, newname, - (Tcl_ObjCmdProc *)mp_Cmd, (ClientData)mpf, NULL); - res = Tcl_NewStringObj(newname, strlen(newname)); - Tcl_SetObjResult(interp, res); + + (void)mpf->close(mpf, 0); + goto error; } + + /* + * Success. Set up return. Set up new info and command widget for + * this mpool. + */ + envip->i_envmpid++; + ip->i_parent = envip; + ip->i_pgsz = pgsize; + _SetInfoData(ip, mpf); + Tcl_CreateObjCommand(interp, newname, + (Tcl_ObjCmdProc *)mp_Cmd, (ClientData)mpf, NULL); + res = Tcl_NewStringObj(newname, strlen(newname)); + Tcl_SetObjResult(interp, res); + error: return (result); } @@ -320,8 +334,8 @@ tcl_MpStat(interp, objc, objv, envp) return (TCL_ERROR); } _debug_check(); - ret = memp_stat(envp, &sp, &fsp, NULL); - result = _ReturnSetup(interp, ret, "memp stat"); + ret = envp->memp_stat(envp, &sp, &fsp, 0); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "memp stat"); if (result == TCL_ERROR) return (result); @@ -333,35 +347,48 @@ tcl_MpStat(interp, objc, objv, envp) /* * MAKE_STAT_LIST assumes 'res' and 'error' label. */ - MAKE_STAT_LIST("Region size", sp->st_regsize); MAKE_STAT_LIST("Cache size (gbytes)", sp->st_gbytes); MAKE_STAT_LIST("Cache size (bytes)", sp->st_bytes); - MAKE_STAT_LIST("Cache hits", sp->st_cache_hit); - MAKE_STAT_LIST("Cache misses", sp->st_cache_miss); MAKE_STAT_LIST("Number of caches", sp->st_ncache); + MAKE_STAT_LIST("Region size", sp->st_regsize); MAKE_STAT_LIST("Pages mapped into address space", sp->st_map); + MAKE_STAT_LIST("Cache hits", sp->st_cache_hit); + MAKE_STAT_LIST("Cache misses", sp->st_cache_miss); MAKE_STAT_LIST("Pages created", sp->st_page_create); MAKE_STAT_LIST("Pages read in", sp->st_page_in); MAKE_STAT_LIST("Pages written", sp->st_page_out); MAKE_STAT_LIST("Clean page evictions", sp->st_ro_evict); MAKE_STAT_LIST("Dirty page evictions", sp->st_rw_evict); + MAKE_STAT_LIST("Dirty pages trickled", sp->st_page_trickle); + MAKE_STAT_LIST("Cached pages", sp->st_pages); + MAKE_STAT_LIST("Cached clean pages", sp->st_page_clean); + MAKE_STAT_LIST("Cached dirty pages", sp->st_page_dirty); MAKE_STAT_LIST("Hash buckets", sp->st_hash_buckets); MAKE_STAT_LIST("Hash lookups", sp->st_hash_searches); MAKE_STAT_LIST("Longest hash chain found", sp->st_hash_longest); MAKE_STAT_LIST("Hash elements examined", sp->st_hash_examined); - MAKE_STAT_LIST("Cached clean pages", sp->st_page_clean); - MAKE_STAT_LIST("Cached dirty pages", sp->st_page_dirty); - MAKE_STAT_LIST("Dirty pages trickled", sp->st_page_trickle); - MAKE_STAT_LIST("Number of region lock waits", sp->st_region_wait); + MAKE_STAT_LIST("Number of hash bucket nowaits", sp->st_hash_nowait); + MAKE_STAT_LIST("Number of hash bucket waits", sp->st_hash_wait); + MAKE_STAT_LIST("Maximum number of hash bucket waits", + sp->st_hash_max_wait); MAKE_STAT_LIST("Number of region lock nowaits", sp->st_region_nowait); + MAKE_STAT_LIST("Number of region lock waits", sp->st_region_wait); + MAKE_STAT_LIST("Page allocations", sp->st_alloc); + MAKE_STAT_LIST("Buckets examined during allocation", + sp->st_alloc_buckets); + MAKE_STAT_LIST("Maximum buckets examined during allocation", + sp->st_alloc_max_buckets); + MAKE_STAT_LIST("Pages examined during allocation", sp->st_alloc_pages); + MAKE_STAT_LIST("Maximum pages examined during allocation", + sp->st_alloc_max_pages); + /* * Save global stat list as res1. The MAKE_STAT_LIST * macro assumes 'res' so we'll use that to build up * our per-file sublist. */ res1 = res; - savefsp = fsp; - for (; fsp != NULL && *fsp != NULL; fsp++) { + for (savefsp = fsp; fsp != NULL && *fsp != NULL; fsp++) { res = Tcl_NewObj(); result = _SetListElem(interp, res, "File Name", strlen("File Name"), (*fsp)->file_name, @@ -369,16 +396,16 @@ tcl_MpStat(interp, objc, objv, envp) if (result != TCL_OK) goto error; MAKE_STAT_LIST("Page size", (*fsp)->st_pagesize); - MAKE_STAT_LIST("Cache Hits", (*fsp)->st_cache_hit); - MAKE_STAT_LIST("Cache Misses", (*fsp)->st_cache_miss); MAKE_STAT_LIST("Pages mapped into address space", (*fsp)->st_map); + MAKE_STAT_LIST("Cache hits", (*fsp)->st_cache_hit); + MAKE_STAT_LIST("Cache misses", (*fsp)->st_cache_miss); MAKE_STAT_LIST("Pages created", (*fsp)->st_page_create); MAKE_STAT_LIST("Pages read in", (*fsp)->st_page_in); MAKE_STAT_LIST("Pages written", (*fsp)->st_page_out); /* - * Now that we have a complete "per-file" stat - * list, append that to the other list. + * Now that we have a complete "per-file" stat list, append + * that to the other list. */ result = Tcl_ListObjAppendElement(interp, res1, res); if (result != TCL_OK) @@ -386,9 +413,9 @@ tcl_MpStat(interp, objc, objv, envp) } Tcl_SetObjResult(interp, res1); error: - __os_free(sp, sizeof(*sp)); + free(sp); if (savefsp != NULL) - __os_free(savefsp, 0); + free(savefsp); return (result); } @@ -398,17 +425,21 @@ error: */ static int mp_Cmd(clientData, interp, objc, objv) - ClientData clientData; /* Mp handle */ - Tcl_Interp *interp; /* Interpreter */ - int objc; /* How many arguments? */ - Tcl_Obj *CONST objv[]; /* The argument objects */ + ClientData clientData; /* Mp handle */ + Tcl_Interp *interp; /* Interpreter */ + int objc; /* How many arguments? */ + Tcl_Obj *CONST objv[]; /* The argument objects */ { static char *mpcmds[] = { - "close", "fsync", "get", + "close", + "fsync", + "get", NULL }; enum mpcmds { - MPCLOSE, MPFSYNC, MPGET + MPCLOSE, + MPFSYNC, + MPGET }; DB_MPOOLFILE *mp; int cmdindex, length, result, ret; @@ -447,8 +478,9 @@ mp_Cmd(clientData, interp, objc, objv) return (TCL_ERROR); } _debug_check(); - ret = memp_fclose(mp); - result = _ReturnSetup(interp, ret, "mp close"); + ret = mp->close(mp, 0); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "mp close"); _MpInfoDelete(interp, mpip); (void)Tcl_DeleteCommand(interp, mpip->i_name); _DeleteInfo(mpip); @@ -459,7 +491,7 @@ mp_Cmd(clientData, interp, objc, objv) return (TCL_ERROR); } _debug_check(); - ret = memp_fsync(mp); + ret = mp->sync(mp); res = Tcl_NewIntObj(ret); break; case MPGET: @@ -487,11 +519,15 @@ tcl_MpGet(interp, objc, objv, mp, mpip) DBTCL_INFO *mpip; /* mp info pointer */ { static char *mpget[] = { - "-create", "-last", "-new", + "-create", + "-last", + "-new", NULL }; enum mpget { - MPGET_CREATE, MPGET_LAST, MPGET_NEW + MPGET_CREATE, + MPGET_LAST, + MPGET_NEW }; DBTCL_INFO *ip; @@ -559,8 +595,8 @@ tcl_MpGet(interp, objc, objv, mp, mpip) } _debug_check(); pgno = ipgno; - ret = memp_fget(mp, &pgno, flag, &page); - result = _ReturnSetup(interp, ret, "mpool get"); + ret = mp->get(mp, &pgno, flag, &page); + result = _ReturnSetup(interp, ret, DB_RETOK_MPGET(ret), "mpool get"); if (result == TCL_ERROR) _DeleteInfo(ip); else { @@ -588,10 +624,10 @@ error: */ static int pg_Cmd(clientData, interp, objc, objv) - ClientData clientData; /* Page handle */ - Tcl_Interp *interp; /* Interpreter */ - int objc; /* How many arguments? */ - Tcl_Obj *CONST objv[]; /* The argument objects */ + ClientData clientData; /* Page handle */ + Tcl_Interp *interp; /* Interpreter */ + int objc; /* How many arguments? */ + Tcl_Obj *CONST objv[]; /* The argument objects */ { static char *pgcmds[] = { "init", @@ -648,7 +684,7 @@ pg_Cmd(clientData, interp, objc, objv) res = NULL; switch ((enum pgcmds)cmdindex) { case PGNUM: - res = Tcl_NewIntObj(pgip->i_pgno); + res = Tcl_NewLongObj((long)pgip->i_pgno); break; case PGSIZE: res = Tcl_NewLongObj(pgip->i_pgsz); @@ -685,11 +721,15 @@ tcl_Pg(interp, objc, objv, page, mp, pgip, putop) int putop; /* Operation */ { static char *pgopt[] = { - "-clean", "-dirty", "-discard", + "-clean", + "-dirty", + "-discard", NULL }; enum pgopt { - PGCLEAN, PGDIRTY, PGDISCARD + PGCLEAN, + PGDIRTY, + PGDISCARD }; u_int32_t flag; int i, optindex, result, ret; @@ -717,11 +757,11 @@ tcl_Pg(interp, objc, objv, page, mp, pgip, putop) _debug_check(); if (putop) - ret = memp_fput(mp, page, flag); + ret = mp->put(mp, page, flag); else - ret = memp_fset(mp, page, flag); + ret = mp->set(mp, page, flag); - result = _ReturnSetup(interp, ret, "page"); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "page"); if (putop) { (void)Tcl_DeleteCommand(interp, pgip->i_name); @@ -756,7 +796,8 @@ tcl_PgInit(interp, objc, objv, page, pgip) s = Tcl_GetByteArrayFromObj(objv[2], &length); if (s == NULL) return (TCL_ERROR); - memcpy(page, s, ((size_t)length < pgsz) ? length : pgsz); + memcpy(page, s, + ((size_t)length < pgsz) ? (size_t)length : pgsz); result = TCL_OK; } else { p = (long *)page; @@ -795,8 +836,8 @@ tcl_PgIsset(interp, objc, objv, page, pgip) return (TCL_ERROR); result = TCL_OK; - if (memcmp(page, - s, ((size_t)length < pgsz) ? length : pgsz ) != 0) { + if (memcmp(page, s, + ((size_t)length < pgsz) ? (size_t)length : pgsz ) != 0) { res = Tcl_NewIntObj(0); Tcl_SetObjResult(interp, res); return (result); @@ -820,3 +861,4 @@ tcl_PgIsset(interp, objc, objv, page, pgip) Tcl_SetObjResult(interp, res); return (result); } +#endif diff --git a/bdb/tcl/tcl_rep.c b/bdb/tcl/tcl_rep.c new file mode 100644 index 00000000000..c72c9971338 --- /dev/null +++ b/bdb/tcl/tcl_rep.c @@ -0,0 +1,405 @@ +/*- + * See the file LICENSE for redistribution information. + * + * Copyright (c) 1999-2002 + * Sleepycat Software. All rights reserved. + */ + +#include "db_config.h" + +#ifndef lint +static const char revid[] = "$Id: tcl_rep.c,v 11.85 2002/08/06 04:45:44 bostic Exp $"; +#endif /* not lint */ + +#ifndef NO_SYSTEM_INCLUDES +#include <sys/types.h> + +#include <stdlib.h> +#include <string.h> +#include <tcl.h> +#endif + +#include "db_int.h" +#include "dbinc/tcl_db.h" + +#if CONFIG_TEST +/* + * tcl_RepElect -- + * Call DB_ENV->rep_elect(). + * + * PUBLIC: int tcl_RepElect + * PUBLIC: __P((Tcl_Interp *, int, Tcl_Obj * CONST *, DB_ENV *)); + */ +int +tcl_RepElect(interp, objc, objv, dbenv) + Tcl_Interp *interp; /* Interpreter */ + int objc; /* How many arguments? */ + Tcl_Obj *CONST objv[]; /* The argument objects */ + DB_ENV *dbenv; /* Environment pointer */ +{ + int eid, nsites, pri, result, ret; + u_int32_t timeout; + + if (objc != 5) { + Tcl_WrongNumArgs(interp, 5, objv, "nsites pri timeout"); + return (TCL_ERROR); + } + + if ((result = Tcl_GetIntFromObj(interp, objv[2], &nsites)) != TCL_OK) + return (result); + if ((result = Tcl_GetIntFromObj(interp, objv[3], &pri)) != TCL_OK) + return (result); + if ((result = _GetUInt32(interp, objv[4], &timeout)) != TCL_OK) + return (result); + + _debug_check(); + if ((ret = dbenv->rep_elect(dbenv, nsites, pri, timeout, &eid)) != 0) + return (_ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "env rep_elect")); + + Tcl_SetObjResult(interp, Tcl_NewIntObj(eid)); + + return (TCL_OK); +} +#endif + +#if CONFIG_TEST +/* + * tcl_RepFlush -- + * Call DB_ENV->rep_flush(). + * + * PUBLIC: int tcl_RepFlush + * PUBLIC: __P((Tcl_Interp *, int, Tcl_Obj * CONST *, DB_ENV *)); + */ +int +tcl_RepFlush(interp, objc, objv, dbenv) + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; + DB_ENV *dbenv; +{ + int ret; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 2, objv, ""); + return TCL_ERROR; + } + + _debug_check(); + ret = dbenv->rep_flush(dbenv); + return (_ReturnSetup(interp, ret, DB_RETOK_STD(ret), "env rep_flush")); +} +#endif +#if CONFIG_TEST +/* + * tcl_RepLimit -- + * Call DB_ENV->set_rep_limit(). + * + * PUBLIC: int tcl_RepLimit + * PUBLIC: __P((Tcl_Interp *, int, Tcl_Obj * CONST *, DB_ENV *)); + */ +int +tcl_RepLimit(interp, objc, objv, dbenv) + Tcl_Interp *interp; /* Interpreter */ + int objc; /* How many arguments? */ + Tcl_Obj *CONST objv[]; /* The argument objects */ + DB_ENV *dbenv; /* Environment pointer */ +{ + int result, ret; + u_int32_t bytes, gbytes; + + if (objc != 4) { + Tcl_WrongNumArgs(interp, 4, objv, "gbytes bytes"); + return (TCL_ERROR); + } + + if ((result = _GetUInt32(interp, objv[2], &gbytes)) != TCL_OK) + return (result); + if ((result = _GetUInt32(interp, objv[3], &bytes)) != TCL_OK) + return (result); + + _debug_check(); + if ((ret = dbenv->set_rep_limit(dbenv, gbytes, bytes)) != 0) + return (_ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "env set_rep_limit")); + + return (_ReturnSetup(interp, + ret, DB_RETOK_STD(ret), "env set_rep_limit")); +} +#endif + +#if CONFIG_TEST +/* + * tcl_RepRequest -- + * Call DB_ENV->set_rep_request(). + * + * PUBLIC: int tcl_RepRequest + * PUBLIC: __P((Tcl_Interp *, int, Tcl_Obj * CONST *, DB_ENV *)); + */ +int +tcl_RepRequest(interp, objc, objv, dbenv) + Tcl_Interp *interp; /* Interpreter */ + int objc; /* How many arguments? */ + Tcl_Obj *CONST objv[]; /* The argument objects */ + DB_ENV *dbenv; /* Environment pointer */ +{ + int result, ret; + u_int32_t min, max; + + if (objc != 4) { + Tcl_WrongNumArgs(interp, 4, objv, "min max"); + return (TCL_ERROR); + } + + if ((result = _GetUInt32(interp, objv[2], &min)) != TCL_OK) + return (result); + if ((result = _GetUInt32(interp, objv[3], &max)) != TCL_OK) + return (result); + + _debug_check(); + if ((ret = dbenv->set_rep_request(dbenv, min, max)) != 0) + return (_ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "env set_rep_request")); + + return (_ReturnSetup(interp, + ret, DB_RETOK_STD(ret), "env set_rep_request")); +} +#endif + +#if CONFIG_TEST +/* + * tcl_RepStart -- + * Call DB_ENV->rep_start(). + * + * PUBLIC: int tcl_RepStart + * PUBLIC: __P((Tcl_Interp *, int, Tcl_Obj * CONST *, DB_ENV *)); + * + * Note that this normally can/should be achieved as an argument to + * berkdb env, but we need to test forcible upgrading of clients, which + * involves calling this on an open environment handle. + */ +int +tcl_RepStart(interp, objc, objv, dbenv) + Tcl_Interp *interp; /* Interpreter */ + int objc; /* How many arguments? */ + Tcl_Obj *CONST objv[]; /* The argument objects */ + DB_ENV *dbenv; +{ + static char *tclrpstrt[] = { + "-client", + "-master", + NULL + }; + enum tclrpstrt { + TCL_RPSTRT_CLIENT, + TCL_RPSTRT_MASTER + }; + char *arg; + int i, optindex, ret; + u_int32_t flag; + + flag = 0; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 3, objv, "[-master/-client]"); + return (TCL_ERROR); + } + + i = 2; + while (i < objc) { + if (Tcl_GetIndexFromObj(interp, objv[i], tclrpstrt, + "option", TCL_EXACT, &optindex) != TCL_OK) { + arg = Tcl_GetStringFromObj(objv[i], NULL); + if (arg[0] == '-') + return (IS_HELP(objv[i])); + else + Tcl_ResetResult(interp); + break; + } + i++; + switch ((enum tclrpstrt)optindex) { + case TCL_RPSTRT_CLIENT: + flag |= DB_REP_CLIENT; + break; + case TCL_RPSTRT_MASTER: + flag |= DB_REP_MASTER; + break; + } + } + + _debug_check(); + ret = dbenv->rep_start(dbenv, NULL, flag); + return (_ReturnSetup(interp, ret, DB_RETOK_STD(ret), "env rep_start")); +} +#endif + +#if CONFIG_TEST +/* + * tcl_RepProcessMessage -- + * Call DB_ENV->rep_process_message(). + * + * PUBLIC: int tcl_RepProcessMessage + * PUBLIC: __P((Tcl_Interp *, int, Tcl_Obj * CONST *, DB_ENV *)); + */ +int +tcl_RepProcessMessage(interp, objc, objv, dbenv) + Tcl_Interp *interp; /* Interpreter */ + int objc; /* How many arguments? */ + Tcl_Obj *CONST objv[]; /* The argument objects */ + DB_ENV *dbenv; /* Environment pointer */ +{ + DBT control, rec; + Tcl_Obj *res; + void *ctmp, *rtmp; + int eid; + int freectl, freerec, result, ret; + + if (objc != 5) { + Tcl_WrongNumArgs(interp, 5, objv, "id control rec"); + return (TCL_ERROR); + } + freectl = freerec = 0; + + memset(&control, 0, sizeof(control)); + memset(&rec, 0, sizeof(rec)); + + if ((result = Tcl_GetIntFromObj(interp, objv[2], &eid)) != TCL_OK) + return (result); + + ret = _CopyObjBytes(interp, objv[3], &ctmp, + &control.size, &freectl); + if (ret != 0) { + result = _ReturnSetup(interp, ret, + DB_RETOK_REPPMSG(ret), "rep_proc_msg"); + return (result); + } + control.data = ctmp; + ret = _CopyObjBytes(interp, objv[4], &rtmp, + &rec.size, &freerec); + if (ret != 0) { + result = _ReturnSetup(interp, ret, + DB_RETOK_REPPMSG(ret), "rep_proc_msg"); + goto out; + } + rec.data = rtmp; + _debug_check(); + ret = dbenv->rep_process_message(dbenv, &control, &rec, &eid); + result = _ReturnSetup(interp, ret, DB_RETOK_REPPMSG(ret), + "env rep_process_message"); + + /* + * If we have a new master, return its environment ID. + * + * XXX + * We should do something prettier to differentiate success + * from an env ID, and figure out how to represent HOLDELECTION. + */ + if (result == TCL_OK && ret == DB_REP_NEWMASTER) { + res = Tcl_NewIntObj(eid); + Tcl_SetObjResult(interp, res); + } +out: + if (freectl) + (void)__os_free(NULL, ctmp); + if (freerec) + (void)__os_free(NULL, rtmp); + + return (result); +} +#endif + +#if CONFIG_TEST +/* + * tcl_RepStat -- + * Call DB_ENV->rep_stat(). + * + * PUBLIC: int tcl_RepStat + * PUBLIC: __P((Tcl_Interp *, int, Tcl_Obj * CONST *, DB_ENV *)); + */ +int +tcl_RepStat(interp, objc, objv, dbenv) + Tcl_Interp *interp; /* Interpreter */ + int objc; /* How many arguments? */ + Tcl_Obj *CONST objv[]; /* The argument objects */ + DB_ENV *dbenv; +{ + DB_REP_STAT *sp; + Tcl_Obj *myobjv[2], *res, *thislist, *lsnlist; + u_int32_t flag; + int myobjc, result, ret; + char *arg; + + result = TCL_OK; + flag = 0; + + if (objc > 3) { + Tcl_WrongNumArgs(interp, 2, objv, NULL); + return (TCL_ERROR); + } + if (objc == 3) { + arg = Tcl_GetStringFromObj(objv[2], NULL); + if (strcmp(arg, "-clear") == 0) + flag = DB_STAT_CLEAR; + else { + Tcl_SetResult(interp, + "db stat: unknown arg", TCL_STATIC); + return (TCL_ERROR); + } + } + + _debug_check(); + ret = dbenv->rep_stat(dbenv, &sp, flag); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "rep stat"); + if (result == TCL_ERROR) + return (result); + + /* + * Have our stats, now construct the name value + * list pairs and free up the memory. + */ + res = Tcl_NewObj(); + /* + * MAKE_STAT_* assumes 'res' and 'error' label. + */ + MAKE_STAT_LSN("Next LSN expected", &sp->st_next_lsn); + MAKE_STAT_LSN("First missed LSN", &sp->st_waiting_lsn); + MAKE_STAT_LIST("Duplicate master conditions", sp->st_dupmasters); + MAKE_STAT_LIST("Environment ID", sp->st_env_id); + MAKE_STAT_LIST("Environment priority", sp->st_env_priority); + MAKE_STAT_LIST("Generation number", sp->st_gen); + MAKE_STAT_LIST("Duplicate log records received", sp->st_log_duplicated); + MAKE_STAT_LIST("Current log records queued", sp->st_log_queued); + MAKE_STAT_LIST("Maximum log records queued", sp->st_log_queued_max); + MAKE_STAT_LIST("Total log records queued", sp->st_log_queued_total); + MAKE_STAT_LIST("Log records received", sp->st_log_records); + MAKE_STAT_LIST("Log records requested", sp->st_log_requested); + MAKE_STAT_LIST("Master environment ID", sp->st_master); + MAKE_STAT_LIST("Master changes", sp->st_master_changes); + MAKE_STAT_LIST("Messages with bad generation number", + sp->st_msgs_badgen); + MAKE_STAT_LIST("Messages processed", sp->st_msgs_processed); + MAKE_STAT_LIST("Messages ignored for recovery", sp->st_msgs_recover); + MAKE_STAT_LIST("Message send failures", sp->st_msgs_send_failures); + MAKE_STAT_LIST("Messages sent", sp->st_msgs_sent); + MAKE_STAT_LIST("New site messages", sp->st_newsites); + MAKE_STAT_LIST("Transmission limited", sp->st_nthrottles); + MAKE_STAT_LIST("Outdated conditions", sp->st_outdated); + MAKE_STAT_LIST("Transactions applied", sp->st_txns_applied); + MAKE_STAT_LIST("Elections held", sp->st_elections); + MAKE_STAT_LIST("Elections won", sp->st_elections_won); + MAKE_STAT_LIST("Election phase", sp->st_election_status); + MAKE_STAT_LIST("Election winner", sp->st_election_cur_winner); + MAKE_STAT_LIST("Election generation number", sp->st_election_gen); + MAKE_STAT_LSN("Election max LSN", &sp->st_election_lsn); + MAKE_STAT_LIST("Election sites", sp->st_election_nsites); + MAKE_STAT_LIST("Election priority", sp->st_election_priority); + MAKE_STAT_LIST("Election tiebreaker", sp->st_election_tiebreaker); + MAKE_STAT_LIST("Election votes", sp->st_election_votes); + + Tcl_SetObjResult(interp, res); +error: + free(sp); + return (result); +} +#endif diff --git a/bdb/tcl/tcl_txn.c b/bdb/tcl/tcl_txn.c index dfe6b6cf60f..b5fab637943 100644 --- a/bdb/tcl/tcl_txn.c +++ b/bdb/tcl/tcl_txn.c @@ -1,14 +1,14 @@ /*- * See the file LICENSE for redistribution information. * - * Copyright (c) 1999, 2000 + * Copyright (c) 1999-2001 * Sleepycat Software. All rights reserved. */ #include "db_config.h" #ifndef lint -static const char revid[] = "$Id: tcl_txn.c,v 11.24 2000/12/31 19:26:23 bostic Exp $"; +static const char revid[] = "$Id: tcl_txn.c,v 11.57 2002/08/06 06:21:36 bostic Exp $"; #endif /* not lint */ #ifndef NO_SYSTEM_INCLUDES @@ -20,13 +20,11 @@ static const char revid[] = "$Id: tcl_txn.c,v 11.24 2000/12/31 19:26:23 bostic E #endif #include "db_int.h" -#include "tcl_db.h" +#include "dbinc/tcl_db.h" -/* - * Prototypes for procedures defined later in this file: - */ -static int tcl_TxnCommit __P((Tcl_Interp *, int, Tcl_Obj * CONST*, - DB_TXN *, DBTCL_INFO *)); +static int tcl_TxnCommit __P((Tcl_Interp *, + int, Tcl_Obj * CONST *, DB_TXN *, DBTCL_INFO *)); +static int txn_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST *)); /* * _TxnInfoDelete -- @@ -39,7 +37,7 @@ static int tcl_TxnCommit __P((Tcl_Interp *, int, Tcl_Obj * CONST*, */ void _TxnInfoDelete(interp, txnip) - Tcl_Interp *interp; /* Interpreter */ + Tcl_Interp *interp; /* Interpreter */ DBTCL_INFO *txnip; /* Info for txn */ { DBTCL_INFO *nextp, *p; @@ -115,8 +113,9 @@ tcl_TxnCheckpoint(interp, objc, objv, envp) } } _debug_check(); - ret = txn_checkpoint(envp, (u_int32_t)kb, (u_int32_t)min, 0); - result = _ReturnSetup(interp, ret, "txn checkpoint"); + ret = envp->txn_checkpoint(envp, (u_int32_t)kb, (u_int32_t)min, 0); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "txn checkpoint"); return (result); } @@ -135,6 +134,11 @@ tcl_Txn(interp, objc, objv, envp, envip) DBTCL_INFO *envip; /* Info pointer */ { static char *txnopts[] = { +#if CONFIG_TEST + "-dirty", + "-lock_timeout", + "-txn_timeout", +#endif "-nosync", "-nowait", "-parent", @@ -142,16 +146,22 @@ tcl_Txn(interp, objc, objv, envp, envip) NULL }; enum txnopts { - TXN_NOSYNC, - TXN_NOWAIT, - TXN_PARENT, - TXN_SYNC +#if CONFIG_TEST + TXNDIRTY, + TXN_LOCK_TIMEOUT, + TXN_TIMEOUT, +#endif + TXNNOSYNC, + TXNNOWAIT, + TXNPARENT, + TXNSYNC }; DBTCL_INFO *ip; DB_TXN *parent; DB_TXN *txn; Tcl_Obj *res; - u_int32_t flag; + db_timeout_t lk_time, tx_time; + u_int32_t flag, lk_timeflag, tx_timeflag; int i, optindex, result, ret; char *arg, msg[MSG_SIZE], newname[MSG_SIZE]; @@ -160,6 +170,7 @@ tcl_Txn(interp, objc, objv, envp, envip) parent = NULL; flag = 0; + lk_timeflag = tx_timeflag = 0; i = 2; while (i < objc) { if (Tcl_GetIndexFromObj(interp, objv[i], @@ -168,7 +179,37 @@ tcl_Txn(interp, objc, objv, envp, envip) } i++; switch ((enum txnopts)optindex) { - case TXN_PARENT: +#ifdef CONFIG_TEST + case TXNDIRTY: + flag |= DB_DIRTY_READ; + break; + case TXN_LOCK_TIMEOUT: + lk_timeflag = DB_SET_LOCK_TIMEOUT; + goto getit; + case TXN_TIMEOUT: + tx_timeflag = DB_SET_TXN_TIMEOUT; +getit: + if (i >= objc) { + Tcl_WrongNumArgs(interp, 2, objv, + "?-txn_timestamp time?"); + return (TCL_ERROR); + } + result = Tcl_GetLongFromObj(interp, objv[i++], + (long *)(optindex == TXN_LOCK_TIMEOUT ? + &lk_time : &tx_time)); + if (result != TCL_OK) + return (TCL_ERROR); + break; +#endif + case TXNNOSYNC: + FLAG_CHECK2(flag, DB_DIRTY_READ); + flag |= DB_TXN_NOSYNC; + break; + case TXNNOWAIT: + FLAG_CHECK2(flag, DB_DIRTY_READ); + flag |= DB_TXN_NOWAIT; + break; + case TXNPARENT: if (i == objc) { Tcl_WrongNumArgs(interp, 2, objv, "?-parent txn?"); @@ -185,18 +226,10 @@ tcl_Txn(interp, objc, objv, envp, envip) return (TCL_ERROR); } break; - case TXN_NOWAIT: - FLAG_CHECK(flag); - flag |= DB_TXN_NOWAIT; - break; - case TXN_SYNC: - FLAG_CHECK(flag); + case TXNSYNC: + FLAG_CHECK2(flag, DB_DIRTY_READ); flag |= DB_TXN_SYNC; break; - case TXN_NOSYNC: - FLAG_CHECK(flag); - flag |= DB_TXN_NOSYNC; - break; } } snprintf(newname, sizeof(newname), "%s.txn%d", @@ -208,8 +241,9 @@ tcl_Txn(interp, objc, objv, envp, envip) return (TCL_ERROR); } _debug_check(); - ret = txn_begin(envp, parent, &txn, flag); - result = _ReturnSetup(interp, ret, "txn"); + ret = envp->txn_begin(envp, parent, &txn, flag); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "txn"); if (result == TCL_ERROR) _DeleteInfo(ip); else { @@ -227,6 +261,24 @@ tcl_Txn(interp, objc, objv, envp, envip) (Tcl_ObjCmdProc *)txn_Cmd, (ClientData)txn, NULL); res = Tcl_NewStringObj(newname, strlen(newname)); Tcl_SetObjResult(interp, res); + if (tx_timeflag != 0) { + ret = txn->set_timeout(txn, tx_time, tx_timeflag); + if (ret != 0) { + result = + _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "set_timeout"); + _DeleteInfo(ip); + } + } + if (lk_timeflag != 0) { + ret = txn->set_timeout(txn, lk_time, lk_timeflag); + if (ret != 0) { + result = + _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "set_timeout"); + _DeleteInfo(ip); + } + } } return (result); } @@ -244,21 +296,6 @@ tcl_TxnStat(interp, objc, objv, envp) Tcl_Obj *CONST objv[]; /* The argument objects */ DB_ENV *envp; /* Environment pointer */ { -#define MAKE_STAT_LSN(s, lsn) \ -do { \ - myobjc = 2; \ - myobjv[0] = Tcl_NewIntObj((lsn)->file); \ - myobjv[1] = Tcl_NewIntObj((lsn)->offset); \ - lsnlist = Tcl_NewListObj(myobjc, myobjv); \ - myobjc = 2; \ - myobjv[0] = Tcl_NewStringObj((s), strlen(s)); \ - myobjv[1] = lsnlist; \ - thislist = Tcl_NewListObj(myobjc, myobjv); \ - result = Tcl_ListObjAppendElement(interp, res, thislist); \ - if (result != TCL_OK) \ - goto error; \ -} while (0); - DBTCL_INFO *ip; DB_TXN_ACTIVE *p; DB_TXN_STAT *sp; @@ -275,8 +312,9 @@ do { \ return (TCL_ERROR); } _debug_check(); - ret = txn_stat(envp, &sp, NULL); - result = _ReturnSetup(interp, ret, "txn stat"); + ret = envp->txn_stat(envp, &sp, 0); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "txn stat"); if (result == TCL_ERROR) return (result); @@ -290,14 +328,15 @@ do { \ */ MAKE_STAT_LIST("Region size", sp->st_regsize); MAKE_STAT_LSN("LSN of last checkpoint", &sp->st_last_ckp); - MAKE_STAT_LSN("LSN of pending checkpoint", &sp->st_pending_ckp); MAKE_STAT_LIST("Time of last checkpoint", sp->st_time_ckp); MAKE_STAT_LIST("Last txn ID allocated", sp->st_last_txnid); MAKE_STAT_LIST("Max Txns", sp->st_maxtxns); MAKE_STAT_LIST("Number aborted txns", sp->st_naborts); MAKE_STAT_LIST("Number active txns", sp->st_nactive); + MAKE_STAT_LIST("Maximum active txns", sp->st_maxnactive); MAKE_STAT_LIST("Number txns begun", sp->st_nbegins); MAKE_STAT_LIST("Number committed txns", sp->st_ncommits); + MAKE_STAT_LIST("Number restored txns", sp->st_nrestores); MAKE_STAT_LIST("Number of region lock waits", sp->st_region_wait); MAKE_STAT_LIST("Number of region lock nowaits", sp->st_region_nowait); for (i = 0, p = sp->st_txnarray; i < sp->st_nactive; i++, p++) @@ -306,7 +345,7 @@ do { \ if (ip->i_type != I_TXN) continue; if (ip->i_type == I_TXN && - (txn_id(ip->i_txnp) == p->txnid)) { + (ip->i_txnp->id(ip->i_txnp) == p->txnid)) { MAKE_STAT_LSN(ip->i_name, &p->lsn); if (p->parentid != 0) MAKE_STAT_STRLIST("Parent", @@ -318,40 +357,78 @@ do { \ } Tcl_SetObjResult(interp, res); error: - __os_free(sp, sizeof(*sp)); + free(sp); return (result); } /* - * txn_Cmd -- - * Implements the "txn" widget. + * tcl_TxnTimeout -- * - * PUBLIC: int txn_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*)); + * PUBLIC: int tcl_TxnTimeout __P((Tcl_Interp *, int, + * PUBLIC: Tcl_Obj * CONST*, DB_ENV *)); */ int +tcl_TxnTimeout(interp, objc, objv, envp) + Tcl_Interp *interp; /* Interpreter */ + int objc; /* How many arguments? */ + Tcl_Obj *CONST objv[]; /* The argument objects */ + DB_ENV *envp; /* Environment pointer */ +{ + long timeout; + int result, ret; + + /* + * One arg, the timeout. + */ + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "?timeout?"); + return (TCL_ERROR); + } + result = Tcl_GetLongFromObj(interp, objv[2], &timeout); + if (result != TCL_OK) + return (result); + _debug_check(); + ret = envp->set_timeout(envp, (u_int32_t)timeout, DB_SET_TXN_TIMEOUT); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "lock timeout"); + return (result); +} + +/* + * txn_Cmd -- + * Implements the "txn" widget. + */ +static int txn_Cmd(clientData, interp, objc, objv) - ClientData clientData; /* Txn handle */ - Tcl_Interp *interp; /* Interpreter */ - int objc; /* How many arguments? */ - Tcl_Obj *CONST objv[]; /* The argument objects */ + ClientData clientData; /* Txn handle */ + Tcl_Interp *interp; /* Interpreter */ + int objc; /* How many arguments? */ + Tcl_Obj *CONST objv[]; /* The argument objects */ { static char *txncmds[] = { - "abort", - "commit", +#if CONFIG_TEST + "discard", "id", "prepare", +#endif + "abort", + "commit", NULL }; enum txncmds { - TXNABORT, - TXNCOMMIT, +#if CONFIG_TEST + TXNDISCARD, TXNID, - TXNPREPARE + TXNPREPARE, +#endif + TXNABORT, + TXNCOMMIT }; DBTCL_INFO *txnip; DB_TXN *txnp; Tcl_Obj *res; int cmdindex, result, ret; + u_int8_t *gid; Tcl_ResetResult(interp); txnp = (DB_TXN *)clientData; @@ -376,38 +453,64 @@ txn_Cmd(clientData, interp, objc, objv) res = NULL; switch ((enum txncmds)cmdindex) { +#if CONFIG_TEST + case TXNDISCARD: + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, NULL); + return (TCL_ERROR); + } + _debug_check(); + ret = txnp->discard(txnp, 0); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "txn discard"); + _TxnInfoDelete(interp, txnip); + (void)Tcl_DeleteCommand(interp, txnip->i_name); + _DeleteInfo(txnip); + break; case TXNID: if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return (TCL_ERROR); } _debug_check(); - ret = txn_id(txnp); + ret = txnp->id(txnp); res = Tcl_NewIntObj(ret); break; case TXNPREPARE: - if (objc != 2) { + if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return (TCL_ERROR); } _debug_check(); - ret = txn_prepare(txnp); - result = _ReturnSetup(interp, ret, "txn prepare"); - break; - case TXNCOMMIT: - result = tcl_TxnCommit(interp, objc, objv, txnp, txnip); + gid = (u_int8_t *)Tcl_GetByteArrayFromObj(objv[2], NULL); + ret = txnp->prepare(txnp, gid); + /* + * !!! + * DB_TXN->prepare commits all outstanding children. But it + * does NOT destroy the current txn handle. So, we must call + * _TxnInfoDelete to recursively remove all nested txn handles, + * we do not call _DeleteInfo on ourselves. + */ _TxnInfoDelete(interp, txnip); - (void)Tcl_DeleteCommand(interp, txnip->i_name); - _DeleteInfo(txnip); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "txn prepare"); break; +#endif case TXNABORT: if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return (TCL_ERROR); } _debug_check(); - ret = txn_abort(txnp); - result = _ReturnSetup(interp, ret, "txn abort"); + ret = txnp->abort(txnp); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "txn abort"); + _TxnInfoDelete(interp, txnip); + (void)Tcl_DeleteCommand(interp, txnip->i_name); + _DeleteInfo(txnip); + break; + case TXNCOMMIT: + result = tcl_TxnCommit(interp, objc, objv, txnp, txnip); _TxnInfoDelete(interp, txnip); (void)Tcl_DeleteCommand(interp, txnip->i_name); _DeleteInfo(txnip); @@ -424,9 +527,9 @@ txn_Cmd(clientData, interp, objc, objv) static int tcl_TxnCommit(interp, objc, objv, txnp, txnip) - Tcl_Interp *interp; /* Interpreter */ - int objc; /* How many arguments? */ - Tcl_Obj *CONST objv[]; /* The argument objects */ + Tcl_Interp *interp; /* Interpreter */ + int objc; /* How many arguments? */ + Tcl_Obj *CONST objv[]; /* The argument objects */ DB_TXN *txnp; /* Transaction pointer */ DBTCL_INFO *txnip; /* Info pointer */ { @@ -467,7 +570,88 @@ tcl_TxnCommit(interp, objc, objv, txnp, txnip) } _debug_check(); - ret = txn_commit(txnp, flag); - result = _ReturnSetup(interp, ret, "txn commit"); + ret = txnp->commit(txnp, flag); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "txn commit"); + return (result); +} + +#if CONFIG_TEST +/* + * tcl_TxnRecover -- + * + * PUBLIC: int tcl_TxnRecover __P((Tcl_Interp *, int, + * PUBLIC: Tcl_Obj * CONST*, DB_ENV *, DBTCL_INFO *)); + */ +int +tcl_TxnRecover(interp, objc, objv, envp, envip) + Tcl_Interp *interp; /* Interpreter */ + int objc; /* How many arguments? */ + Tcl_Obj *CONST objv[]; /* The argument objects */ + DB_ENV *envp; /* Environment pointer */ + DBTCL_INFO *envip; /* Info pointer */ +{ +#define DO_PREPLIST(count) \ +for (i = 0; i < count; i++) { \ + snprintf(newname, sizeof(newname), "%s.txn%d", \ + envip->i_name, envip->i_envtxnid); \ + ip = _NewInfo(interp, NULL, newname, I_TXN); \ + if (ip == NULL) { \ + Tcl_SetResult(interp, "Could not set up info", \ + TCL_STATIC); \ + return (TCL_ERROR); \ + } \ + envip->i_envtxnid++; \ + ip->i_parent = envip; \ + p = &prep[i]; \ + _SetInfoData(ip, p->txn); \ + Tcl_CreateObjCommand(interp, newname, \ + (Tcl_ObjCmdProc *)txn_Cmd, (ClientData)p->txn, NULL); \ + result = _SetListElem(interp, res, newname, strlen(newname), \ + p->gid, DB_XIDDATASIZE); \ + if (result != TCL_OK) \ + goto error; \ +} + + DBTCL_INFO *ip; + DB_PREPLIST prep[DBTCL_PREP], *p; + Tcl_Obj *res; + long count, i; + int result, ret; + char newname[MSG_SIZE]; + + result = TCL_OK; + /* + * No args for this. Error if there are some. + */ + if (objc != 2) { + Tcl_WrongNumArgs(interp, 2, objv, NULL); + return (TCL_ERROR); + } + _debug_check(); + ret = envp->txn_recover(envp, prep, DBTCL_PREP, &count, DB_FIRST); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "txn recover"); + if (result == TCL_ERROR) + return (result); + res = Tcl_NewObj(); + DO_PREPLIST(count); + + /* + * If count returned is the maximum size we have, then there + * might be more. Keep going until we get them all. + */ + while (count == DBTCL_PREP) { + ret = envp->txn_recover( + envp, prep, DBTCL_PREP, &count, DB_NEXT); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), + "txn recover"); + if (result == TCL_ERROR) + return (result); + DO_PREPLIST(count); + } + Tcl_SetObjResult(interp, res); +error: return (result); } +#endif diff --git a/bdb/tcl/tcl_util.c b/bdb/tcl/tcl_util.c new file mode 100644 index 00000000000..3c0665f9e38 --- /dev/null +++ b/bdb/tcl/tcl_util.c @@ -0,0 +1,381 @@ +/*- + * See the file LICENSE for redistribution information. + * + * Copyright (c) 1999-2001 + * Sleepycat Software. All rights reserved. + */ + +#include "db_config.h" + +#ifndef lint +static const char revid[] = "$Id: tcl_util.c,v 11.35 2002/08/06 06:21:42 bostic Exp $"; +#endif /* not lint */ + +#ifndef NO_SYSTEM_INCLUDES +#include <sys/types.h> + +#include <fcntl.h> +#include <stdlib.h> +#include <string.h> +#include <tcl.h> +#endif + +#include "db_int.h" +#include "dbinc/tcl_db.h" + +/* + * Prototypes for procedures defined later in this file: + */ +static int mutex_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*)); + +/* + * bdb_RandCommand -- + * Implements rand* functions. + * + * PUBLIC: int bdb_RandCommand __P((Tcl_Interp *, int, Tcl_Obj * CONST*)); + */ +int +bdb_RandCommand(interp, objc, objv) + Tcl_Interp *interp; /* Interpreter */ + int objc; /* How many arguments? */ + Tcl_Obj *CONST objv[]; /* The argument objects */ +{ + static char *rcmds[] = { + "rand", "random_int", "srand", + NULL + }; + enum rcmds { + RRAND, RRAND_INT, RSRAND + }; + long t; + int cmdindex, hi, lo, result, ret; + Tcl_Obj *res; + char msg[MSG_SIZE]; + + result = TCL_OK; + /* + * Get the command name index from the object based on the cmds + * defined above. This SHOULD NOT fail because we already checked + * in the 'berkdb' command. + */ + if (Tcl_GetIndexFromObj(interp, + objv[1], rcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK) + return (IS_HELP(objv[1])); + + res = NULL; + switch ((enum rcmds)cmdindex) { + case RRAND: + /* + * Must be 0 args. Error if different. + */ + if (objc != 2) { + Tcl_WrongNumArgs(interp, 2, objv, NULL); + return (TCL_ERROR); + } + ret = rand(); + res = Tcl_NewIntObj(ret); + break; + case RRAND_INT: + /* + * Must be 4 args. Error if different. + */ + if (objc != 4) { + Tcl_WrongNumArgs(interp, 2, objv, "lo hi"); + return (TCL_ERROR); + } + result = Tcl_GetIntFromObj(interp, objv[2], &lo); + if (result != TCL_OK) + break; + result = Tcl_GetIntFromObj(interp, objv[3], &hi); + if (result == TCL_OK) { +#ifndef RAND_MAX +#define RAND_MAX 0x7fffffff +#endif + t = rand(); + if (t > RAND_MAX) { + snprintf(msg, MSG_SIZE, + "Max random is higher than %ld\n", + (long)RAND_MAX); + Tcl_SetResult(interp, msg, TCL_VOLATILE); + result = TCL_ERROR; + break; + } + _debug_check(); + ret = (int)(((double)t / ((double)(RAND_MAX) + 1)) * + (hi - lo + 1)); + ret += lo; + res = Tcl_NewIntObj(ret); + } + break; + case RSRAND: + /* + * Must be 1 arg. Error if different. + */ + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "seed"); + return (TCL_ERROR); + } + result = Tcl_GetIntFromObj(interp, objv[2], &lo); + if (result == TCL_OK) { + srand((u_int)lo); + res = Tcl_NewIntObj(0); + } + break; + } + /* + * Only set result if we have a res. Otherwise, lower + * functions have already done so. + */ + if (result == TCL_OK && res) + Tcl_SetObjResult(interp, res); + return (result); +} + +/* + * + * tcl_Mutex -- + * Opens an env mutex. + * + * PUBLIC: int tcl_Mutex __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *, + * PUBLIC: DBTCL_INFO *)); + */ +int +tcl_Mutex(interp, objc, objv, envp, envip) + Tcl_Interp *interp; /* Interpreter */ + int objc; /* How many arguments? */ + Tcl_Obj *CONST objv[]; /* The argument objects */ + DB_ENV *envp; /* Environment pointer */ + DBTCL_INFO *envip; /* Info pointer */ +{ + DBTCL_INFO *ip; + Tcl_Obj *res; + _MUTEX_DATA *md; + int i, mode, nitems, result, ret; + char newname[MSG_SIZE]; + + md = NULL; + result = TCL_OK; + mode = nitems = ret = 0; + memset(newname, 0, MSG_SIZE); + + if (objc != 4) { + Tcl_WrongNumArgs(interp, 2, objv, "mode nitems"); + return (TCL_ERROR); + } + result = Tcl_GetIntFromObj(interp, objv[2], &mode); + if (result != TCL_OK) + return (TCL_ERROR); + result = Tcl_GetIntFromObj(interp, objv[3], &nitems); + if (result != TCL_OK) + return (TCL_ERROR); + + snprintf(newname, sizeof(newname), + "%s.mutex%d", envip->i_name, envip->i_envmutexid); + ip = _NewInfo(interp, NULL, newname, I_MUTEX); + if (ip == NULL) { + Tcl_SetResult(interp, "Could not set up info", + TCL_STATIC); + return (TCL_ERROR); + } + /* + * Set up mutex. + */ + /* + * Map in the region. + * + * XXX + * We don't bother doing this "right", i.e., using the shalloc + * functions, just grab some memory knowing that it's correctly + * aligned. + */ + _debug_check(); + if (__os_calloc(NULL, 1, sizeof(_MUTEX_DATA), &md) != 0) + goto posixout; + md->env = envp; + md->n_mutex = nitems; + md->size = sizeof(_MUTEX_ENTRY) * nitems; + + md->reginfo.type = REGION_TYPE_MUTEX; + md->reginfo.id = INVALID_REGION_TYPE; + md->reginfo.mode = mode; + md->reginfo.flags = REGION_CREATE_OK | REGION_JOIN_OK; + if ((ret = __db_r_attach(envp, &md->reginfo, md->size)) != 0) + goto posixout; + md->marray = md->reginfo.addr; + + /* Initialize a created region. */ + if (F_ISSET(&md->reginfo, REGION_CREATE)) + for (i = 0; i < nitems; i++) { + md->marray[i].val = 0; + if ((ret = __db_mutex_init_int(envp, + &md->marray[i].m, i, 0)) != 0) + goto posixout; + } + R_UNLOCK(envp, &md->reginfo); + + /* + * Success. Set up return. Set up new info + * and command widget for this mutex. + */ + envip->i_envmutexid++; + ip->i_parent = envip; + _SetInfoData(ip, md); + Tcl_CreateObjCommand(interp, newname, + (Tcl_ObjCmdProc *)mutex_Cmd, (ClientData)md, NULL); + res = Tcl_NewStringObj(newname, strlen(newname)); + Tcl_SetObjResult(interp, res); + + return (TCL_OK); + +posixout: + if (ret > 0) + Tcl_PosixError(interp); + result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "mutex"); + _DeleteInfo(ip); + + if (md != NULL) { + if (md->reginfo.addr != NULL) + (void)__db_r_detach(md->env, + &md->reginfo, F_ISSET(&md->reginfo, REGION_CREATE)); + __os_free(md->env, md); + } + return (result); +} + +/* + * mutex_Cmd -- + * Implements the "mutex" widget. + */ +static int +mutex_Cmd(clientData, interp, objc, objv) + ClientData clientData; /* Mutex handle */ + Tcl_Interp *interp; /* Interpreter */ + int objc; /* How many arguments? */ + Tcl_Obj *CONST objv[]; /* The argument objects */ +{ + static char *mxcmds[] = { + "close", + "get", + "getval", + "release", + "setval", + NULL + }; + enum mxcmds { + MXCLOSE, + MXGET, + MXGETVAL, + MXRELE, + MXSETVAL + }; + DB_ENV *dbenv; + DBTCL_INFO *envip, *mpip; + _MUTEX_DATA *mp; + Tcl_Obj *res; + int cmdindex, id, result, newval; + + Tcl_ResetResult(interp); + mp = (_MUTEX_DATA *)clientData; + mpip = _PtrToInfo((void *)mp); + envip = mpip->i_parent; + dbenv = envip->i_envp; + result = TCL_OK; + + if (mp == NULL) { + Tcl_SetResult(interp, "NULL mp pointer", TCL_STATIC); + return (TCL_ERROR); + } + if (mpip == NULL) { + Tcl_SetResult(interp, "NULL mp info pointer", TCL_STATIC); + return (TCL_ERROR); + } + + /* + * Get the command name index from the object based on the dbcmds + * defined above. + */ + if (Tcl_GetIndexFromObj(interp, + objv[1], mxcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK) + return (IS_HELP(objv[1])); + + res = NULL; + switch ((enum mxcmds)cmdindex) { + case MXCLOSE: + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, NULL); + return (TCL_ERROR); + } + _debug_check(); + (void)__db_r_detach(mp->env, &mp->reginfo, 0); + res = Tcl_NewIntObj(0); + (void)Tcl_DeleteCommand(interp, mpip->i_name); + _DeleteInfo(mpip); + __os_free(mp->env, mp); + break; + case MXRELE: + /* + * Check for 1 arg. Error if different. + */ + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "id"); + return (TCL_ERROR); + } + result = Tcl_GetIntFromObj(interp, objv[2], &id); + if (result != TCL_OK) + break; + MUTEX_UNLOCK(dbenv, &mp->marray[id].m); + res = Tcl_NewIntObj(0); + break; + case MXGET: + /* + * Check for 1 arg. Error if different. + */ + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "id"); + return (TCL_ERROR); + } + result = Tcl_GetIntFromObj(interp, objv[2], &id); + if (result != TCL_OK) + break; + MUTEX_LOCK(dbenv, &mp->marray[id].m); + res = Tcl_NewIntObj(0); + break; + case MXGETVAL: + /* + * Check for 1 arg. Error if different. + */ + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "id"); + return (TCL_ERROR); + } + result = Tcl_GetIntFromObj(interp, objv[2], &id); + if (result != TCL_OK) + break; + res = Tcl_NewLongObj((long)mp->marray[id].val); + break; + case MXSETVAL: + /* + * Check for 2 args. Error if different. + */ + if (objc != 4) { + Tcl_WrongNumArgs(interp, 2, objv, "id val"); + return (TCL_ERROR); + } + result = Tcl_GetIntFromObj(interp, objv[2], &id); + if (result != TCL_OK) + break; + result = Tcl_GetIntFromObj(interp, objv[3], &newval); + if (result != TCL_OK) + break; + mp->marray[id].val = newval; + res = Tcl_NewIntObj(0); + break; + } + /* + * Only set result if we have a res. Otherwise, lower + * functions have already done so. + */ + if (result == TCL_OK && res) + Tcl_SetObjResult(interp, res); + return (result); +} |