1/*-
2 * See the file LICENSE for redistribution information.
3 *
4 * Copyright (c) 1999-2009 Oracle.  All rights reserved.
5 *
6 * $Id$
7 */
8
9#include "db_config.h"
10
11#include "db_int.h"
12#ifdef HAVE_SYSTEM_INCLUDE_FILES
13#include <tcl.h>
14#endif
15#include "dbinc/tcl_db.h"
16
17static int tcl_TxnCommit __P((Tcl_Interp *,
18	       int, Tcl_Obj * CONST *, DB_TXN *, DBTCL_INFO *));
19static int txn_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST *));
20
21/*
22 * _TxnInfoDelete --
23 *	Removes nested txn info structures that are children
24 *	of this txn.
25 *	RECURSIVE:  Transactions can be arbitrarily nested, so we
26 *	must recurse down until we get them all.
27 *
28 * PUBLIC: void _TxnInfoDelete __P((Tcl_Interp *, DBTCL_INFO *));
29 */
30void
31_TxnInfoDelete(interp, txnip)
32	Tcl_Interp *interp;		/* Interpreter */
33	DBTCL_INFO *txnip;		/* Info for txn */
34{
35	DBTCL_INFO *nextp, *p;
36
37	for (p = LIST_FIRST(&__db_infohead); p != NULL; p = nextp) {
38		/*
39		 * Check if this info structure "belongs" to this
40		 * txn.  Remove its commands and info structure.
41		 */
42		nextp = LIST_NEXT(p, entries);
43		if (p->i_parent == txnip && p->i_type == I_TXN) {
44			_TxnInfoDelete(interp, p);
45			(void)Tcl_DeleteCommand(interp, p->i_name);
46			_DeleteInfo(p);
47		}
48	}
49}
50
51/*
52 * tcl_TxnCheckpoint --
53 *
54 * PUBLIC: int tcl_TxnCheckpoint __P((Tcl_Interp *, int,
55 * PUBLIC:    Tcl_Obj * CONST*, DB_ENV *));
56 */
57int
58tcl_TxnCheckpoint(interp, objc, objv, dbenv)
59	Tcl_Interp *interp;		/* Interpreter */
60	int objc;			/* How many arguments? */
61	Tcl_Obj *CONST objv[];		/* The argument objects */
62	DB_ENV *dbenv;			/* Environment pointer */
63{
64	static const char *txnckpopts[] = {
65		"-force",
66		"-kbyte",
67		"-min",
68		NULL
69	};
70	enum txnckpopts {
71		TXNCKP_FORCE,
72		TXNCKP_KB,
73		TXNCKP_MIN
74	};
75	u_int32_t flags;
76	int i, kb, min, optindex, result, ret;
77
78	result = TCL_OK;
79	flags = 0;
80	kb = min = 0;
81
82	/*
83	 * Get the flag index from the object based on the options
84	 * defined above.
85	 */
86	i = 2;
87	while (i < objc) {
88		if (Tcl_GetIndexFromObj(interp, objv[i],
89		    txnckpopts, "option", TCL_EXACT, &optindex) != TCL_OK) {
90			return (IS_HELP(objv[i]));
91		}
92		i++;
93		switch ((enum txnckpopts)optindex) {
94		case TXNCKP_FORCE:
95			flags = DB_FORCE;
96			break;
97		case TXNCKP_KB:
98			if (i == objc) {
99				Tcl_WrongNumArgs(interp, 2, objv,
100				    "?-kbyte kb?");
101				result = TCL_ERROR;
102				break;
103			}
104			result = Tcl_GetIntFromObj(interp, objv[i++], &kb);
105			break;
106		case TXNCKP_MIN:
107			if (i == objc) {
108				Tcl_WrongNumArgs(interp, 2, objv, "?-min min?");
109				result = TCL_ERROR;
110				break;
111			}
112			result = Tcl_GetIntFromObj(interp, objv[i++], &min);
113			break;
114		}
115	}
116	_debug_check();
117	ret = dbenv->txn_checkpoint(dbenv, (u_int32_t)kb, (u_int32_t)min,
118	    flags);
119	result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
120	    "txn checkpoint");
121	return (result);
122}
123
124/*
125 * tcl_Txn --
126 *
127 * PUBLIC: int tcl_Txn __P((Tcl_Interp *, int,
128 * PUBLIC:    Tcl_Obj * CONST*, DB_ENV *, DBTCL_INFO *));
129 */
130int
131tcl_Txn(interp, objc, objv, dbenv, envip)
132	Tcl_Interp *interp;		/* Interpreter */
133	int objc;			/* How many arguments? */
134	Tcl_Obj *CONST objv[];		/* The argument objects */
135	DB_ENV *dbenv;			/* Environment pointer */
136	DBTCL_INFO *envip;		/* Info pointer */
137{
138	static const char *txnopts[] = {
139#ifdef CONFIG_TEST
140		"-lock_timeout",
141		"-read_committed",
142		"-read_uncommitted",
143		"-txn_timeout",
144		"-txn_wait",
145#endif
146		"-nosync",
147		"-nowait",
148		"-parent",
149		"-snapshot",
150		"-sync",
151		"-wrnosync",
152		NULL
153	};
154	enum txnopts {
155#ifdef CONFIG_TEST
156		TXNLOCK_TIMEOUT,
157		TXNREAD_COMMITTED,
158		TXNREAD_UNCOMMITTED,
159		TXNTIMEOUT,
160		TXNWAIT,
161#endif
162		TXNNOSYNC,
163		TXNNOWAIT,
164		TXNPARENT,
165		TXNSNAPSHOT,
166		TXNSYNC,
167		TXNWRNOSYNC
168	};
169	DBTCL_INFO *ip;
170	DB_TXN *parent;
171	DB_TXN *txn;
172	Tcl_Obj *res;
173	u_int32_t flag;
174	int i, optindex, result, ret;
175	char *arg, msg[MSG_SIZE], newname[MSG_SIZE];
176#ifdef CONFIG_TEST
177	db_timeout_t lk_time, tx_time;
178	u_int32_t lk_timeflag, tx_timeflag;
179#endif
180
181	result = TCL_OK;
182	memset(newname, 0, MSG_SIZE);
183
184	parent = NULL;
185	flag = 0;
186#ifdef CONFIG_TEST
187	COMPQUIET(tx_time, 0);
188	COMPQUIET(lk_time, 0);
189	lk_timeflag = tx_timeflag = 0;
190#endif
191	i = 2;
192	while (i < objc) {
193		if (Tcl_GetIndexFromObj(interp, objv[i],
194		    txnopts, "option", TCL_EXACT, &optindex) != TCL_OK) {
195			return (IS_HELP(objv[i]));
196		}
197		i++;
198		switch ((enum txnopts)optindex) {
199#ifdef CONFIG_TEST
200		case TXNLOCK_TIMEOUT:
201			lk_timeflag = DB_SET_LOCK_TIMEOUT;
202			goto get_timeout;
203		case TXNTIMEOUT:
204			tx_timeflag = DB_SET_TXN_TIMEOUT;
205get_timeout:		if (i >= objc) {
206				Tcl_WrongNumArgs(interp, 2, objv,
207				    "?-txn_timestamp time?");
208				return (TCL_ERROR);
209			}
210			result = Tcl_GetLongFromObj(interp, objv[i++], (long *)
211			    ((enum txnopts)optindex == TXNLOCK_TIMEOUT ?
212			    &lk_time : &tx_time));
213			if (result != TCL_OK)
214				return (TCL_ERROR);
215			break;
216		case TXNREAD_COMMITTED:
217			flag |= DB_READ_COMMITTED;
218			break;
219		case TXNREAD_UNCOMMITTED:
220			flag |= DB_READ_UNCOMMITTED;
221			break;
222		case TXNWAIT:
223			flag |= DB_TXN_WAIT;
224			break;
225#endif
226		case TXNNOSYNC:
227			flag |= DB_TXN_NOSYNC;
228			break;
229		case TXNNOWAIT:
230			flag |= DB_TXN_NOWAIT;
231			break;
232		case TXNPARENT:
233			if (i == objc) {
234				Tcl_WrongNumArgs(interp, 2, objv,
235				    "?-parent txn?");
236				result = TCL_ERROR;
237				break;
238			}
239			arg = Tcl_GetStringFromObj(objv[i++], NULL);
240			parent = NAME_TO_TXN(arg);
241			if (parent == NULL) {
242				snprintf(msg, MSG_SIZE,
243				    "Invalid parent txn: %s\n",
244				    arg);
245				Tcl_SetResult(interp, msg, TCL_VOLATILE);
246				return (TCL_ERROR);
247			}
248			break;
249		case TXNSNAPSHOT:
250			flag |= DB_TXN_SNAPSHOT;
251			break;
252		case TXNSYNC:
253			flag |= DB_TXN_SYNC;
254			break;
255		case TXNWRNOSYNC:
256			flag |= DB_TXN_WRITE_NOSYNC;
257			break;
258		}
259	}
260	snprintf(newname, sizeof(newname), "%s.txn%d",
261	    envip->i_name, envip->i_envtxnid);
262	ip = _NewInfo(interp, NULL, newname, I_TXN);
263	if (ip == NULL) {
264		Tcl_SetResult(interp, "Could not set up info",
265		    TCL_STATIC);
266		return (TCL_ERROR);
267	}
268	_debug_check();
269	ret = dbenv->txn_begin(dbenv, parent, &txn, flag);
270	result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
271	    "txn");
272	if (result == TCL_ERROR)
273		_DeleteInfo(ip);
274	else {
275		/*
276		 * Success.  Set up return.  Set up new info
277		 * and command widget for this txn.
278		 */
279		envip->i_envtxnid++;
280		if (parent)
281			ip->i_parent = _PtrToInfo(parent);
282		else
283			ip->i_parent = envip;
284		_SetInfoData(ip, txn);
285		(void)Tcl_CreateObjCommand(interp, newname,
286		    (Tcl_ObjCmdProc *)txn_Cmd, (ClientData)txn, NULL);
287		res = NewStringObj(newname, strlen(newname));
288		Tcl_SetObjResult(interp, res);
289#ifdef CONFIG_TEST
290		if (tx_timeflag != 0) {
291			ret = txn->set_timeout(txn, tx_time, tx_timeflag);
292			if (ret != 0) {
293				result =
294				    _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
295					"set_timeout");
296				_DeleteInfo(ip);
297			}
298		}
299		if (lk_timeflag != 0) {
300			ret = txn->set_timeout(txn, lk_time, lk_timeflag);
301			if (ret != 0) {
302				result =
303				    _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
304					"set_timeout");
305				_DeleteInfo(ip);
306			}
307		}
308#endif
309	}
310	return (result);
311}
312
313/*
314 * tcl_CDSGroup --
315 *
316 * PUBLIC: int tcl_CDSGroup __P((Tcl_Interp *, int,
317 * PUBLIC:    Tcl_Obj * CONST*, DB_ENV *, DBTCL_INFO *));
318 */
319int
320tcl_CDSGroup(interp, objc, objv, dbenv, envip)
321	Tcl_Interp *interp;		/* Interpreter */
322	int objc;			/* How many arguments? */
323	Tcl_Obj *CONST objv[];		/* The argument objects */
324	DB_ENV *dbenv;			/* Environment pointer */
325	DBTCL_INFO *envip;		/* Info pointer */
326{
327	DBTCL_INFO *ip;
328	DB_TXN *txn;
329	Tcl_Obj *res;
330	int result, ret;
331	char newname[MSG_SIZE];
332
333	if (objc != 2) {
334		Tcl_WrongNumArgs(interp, 1, objv, "env cdsgroup");
335		return (TCL_ERROR);
336	}
337
338	result = TCL_OK;
339	memset(newname, 0, MSG_SIZE);
340
341	snprintf(newname, sizeof(newname), "%s.txn%d",
342	    envip->i_name, envip->i_envtxnid);
343	ip = _NewInfo(interp, NULL, newname, I_TXN);
344	if (ip == NULL) {
345		Tcl_SetResult(interp, "Could not set up info",
346		    TCL_STATIC);
347		return (TCL_ERROR);
348	}
349	_debug_check();
350	ret = dbenv->cdsgroup_begin(dbenv, &txn);
351	result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "cdsgroup");
352	if (result == TCL_ERROR)
353		_DeleteInfo(ip);
354	else {
355		/*
356		 * Success.  Set up return.  Set up new info
357		 * and command widget for this txn.
358		 */
359		envip->i_envtxnid++;
360		ip->i_parent = envip;
361		_SetInfoData(ip, txn);
362		(void)Tcl_CreateObjCommand(interp, newname,
363		    (Tcl_ObjCmdProc *)txn_Cmd, (ClientData)txn, NULL);
364		res = NewStringObj(newname, strlen(newname));
365		Tcl_SetObjResult(interp, res);
366	}
367	return (result);
368}
369
370/*
371 * tcl_TxnStat --
372 *
373 * PUBLIC: int tcl_TxnStat __P((Tcl_Interp *, int,
374 * PUBLIC:    Tcl_Obj * CONST*, DB_ENV *));
375 */
376int
377tcl_TxnStat(interp, objc, objv, dbenv)
378	Tcl_Interp *interp;		/* Interpreter */
379	int objc;			/* How many arguments? */
380	Tcl_Obj *CONST objv[];		/* The argument objects */
381	DB_ENV *dbenv;			/* Environment pointer */
382{
383	DBTCL_INFO *ip;
384	DB_TXN_ACTIVE *p;
385	DB_TXN_STAT *sp;
386	Tcl_Obj *myobjv[2], *res, *thislist, *lsnlist;
387	u_int32_t i;
388	int myobjc, result, ret;
389
390	result = TCL_OK;
391	/*
392	 * No args for this.  Error if there are some.
393	 */
394	if (objc != 2) {
395		Tcl_WrongNumArgs(interp, 2, objv, NULL);
396		return (TCL_ERROR);
397	}
398	_debug_check();
399	ret = dbenv->txn_stat(dbenv, &sp, 0);
400	result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
401	    "txn stat");
402	if (result == TCL_ERROR)
403		return (result);
404
405	/*
406	 * Have our stats, now construct the name value
407	 * list pairs and free up the memory.
408	 */
409	res = Tcl_NewObj();
410	/*
411	 * MAKE_STAT_LIST assumes 'res' and 'error' label.
412	 */
413#ifdef HAVE_STATISTICS
414	MAKE_STAT_LIST("Region size", sp->st_regsize);
415	MAKE_STAT_LSN("LSN of last checkpoint", &sp->st_last_ckp);
416	MAKE_STAT_LIST("Time of last checkpoint", sp->st_time_ckp);
417	MAKE_STAT_LIST("Last txn ID allocated", sp->st_last_txnid);
418	MAKE_STAT_LIST("Maximum txns", sp->st_maxtxns);
419	MAKE_WSTAT_LIST("Number aborted txns", sp->st_naborts);
420	MAKE_WSTAT_LIST("Number txns begun", sp->st_nbegins);
421	MAKE_WSTAT_LIST("Number committed txns", sp->st_ncommits);
422	MAKE_STAT_LIST("Number active txns", sp->st_nactive);
423	MAKE_STAT_LIST("Number of snapshot txns", sp->st_nsnapshot);
424	MAKE_STAT_LIST("Number restored txns", sp->st_nrestores);
425	MAKE_STAT_LIST("Maximum active txns", sp->st_maxnactive);
426	MAKE_STAT_LIST("Maximum snapshot txns", sp->st_maxnsnapshot);
427	MAKE_WSTAT_LIST("Number of region lock waits", sp->st_region_wait);
428	MAKE_WSTAT_LIST("Number of region lock nowaits", sp->st_region_nowait);
429	for (i = 0, p = sp->st_txnarray; i < sp->st_nactive; i++, p++)
430		LIST_FOREACH(ip, &__db_infohead, entries) {
431			if (ip->i_type != I_TXN)
432				continue;
433			if (ip->i_type == I_TXN &&
434			    (ip->i_txnp->id(ip->i_txnp) == p->txnid)) {
435				MAKE_STAT_LSN(ip->i_name, &p->lsn);
436				if (p->parentid != 0)
437					MAKE_STAT_STRLIST("Parent",
438					    ip->i_parent->i_name);
439				else
440					MAKE_STAT_LIST("Parent", 0);
441				break;
442			}
443		}
444#endif
445	Tcl_SetObjResult(interp, res);
446error:
447	__os_ufree(dbenv->env, sp);
448	return (result);
449}
450
451/*
452 * tcl_TxnTimeout --
453 *
454 * PUBLIC: int tcl_TxnTimeout __P((Tcl_Interp *, int,
455 * PUBLIC:    Tcl_Obj * CONST*, DB_ENV *));
456 */
457int
458tcl_TxnTimeout(interp, objc, objv, dbenv)
459	Tcl_Interp *interp;		/* Interpreter */
460	int objc;			/* How many arguments? */
461	Tcl_Obj *CONST objv[];		/* The argument objects */
462	DB_ENV *dbenv;			/* Environment pointer */
463{
464	long timeout;
465	int result, ret;
466
467	/*
468	 * One arg, the timeout.
469	 */
470	if (objc != 3) {
471		Tcl_WrongNumArgs(interp, 2, objv, "?timeout?");
472		return (TCL_ERROR);
473	}
474	result = Tcl_GetLongFromObj(interp, objv[2], &timeout);
475	if (result != TCL_OK)
476		return (result);
477	_debug_check();
478	ret = dbenv->set_timeout(dbenv, (u_int32_t)timeout, DB_SET_TXN_TIMEOUT);
479	result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
480	    "lock timeout");
481	return (result);
482}
483
484/*
485 * txn_Cmd --
486 *	Implements the "txn" widget.
487 */
488static int
489txn_Cmd(clientData, interp, objc, objv)
490	ClientData clientData;		/* Txn handle */
491	Tcl_Interp *interp;		/* Interpreter */
492	int objc;			/* How many arguments? */
493	Tcl_Obj *CONST objv[];		/* The argument objects */
494{
495	static const char *txncmds[] = {
496#ifdef CONFIG_TEST
497		"discard",
498		"getname",
499		"id",
500		"prepare",
501		"setname",
502#endif
503		"abort",
504		"commit",
505		"getname",
506		"setname",
507		NULL
508	};
509	enum txncmds {
510#ifdef CONFIG_TEST
511		TXNDISCARD,
512		TXNGETNAME,
513		TXNID,
514		TXNPREPARE,
515		TXNSETNAME,
516#endif
517		TXNABORT,
518		TXNCOMMIT
519	};
520	DBTCL_INFO *txnip;
521	DB_TXN *txnp;
522	Tcl_Obj *res;
523	int cmdindex, result, ret;
524#ifdef CONFIG_TEST
525	u_int8_t *gid, garray[DB_GID_SIZE];
526	int length;
527	const char *name;
528#endif
529
530	Tcl_ResetResult(interp);
531	txnp = (DB_TXN *)clientData;
532	txnip = _PtrToInfo((void *)txnp);
533	result = TCL_OK;
534	if (txnp == NULL) {
535		Tcl_SetResult(interp, "NULL txn pointer", TCL_STATIC);
536		return (TCL_ERROR);
537	}
538	if (txnip == NULL) {
539		Tcl_SetResult(interp, "NULL txn info pointer", TCL_STATIC);
540		return (TCL_ERROR);
541	}
542
543	/*
544	 * Get the command name index from the object based on the dbcmds
545	 * defined above.
546	 */
547	if (Tcl_GetIndexFromObj(interp,
548	    objv[1], txncmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
549		return (IS_HELP(objv[1]));
550
551	res = NULL;
552	switch ((enum txncmds)cmdindex) {
553#ifdef CONFIG_TEST
554	case TXNDISCARD:
555		if (objc != 2) {
556			Tcl_WrongNumArgs(interp, 1, objv, NULL);
557			return (TCL_ERROR);
558		}
559		_debug_check();
560		ret = txnp->discard(txnp, 0);
561		result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
562		    "txn discard");
563		_TxnInfoDelete(interp, txnip);
564		(void)Tcl_DeleteCommand(interp, txnip->i_name);
565		_DeleteInfo(txnip);
566		break;
567	case TXNID:
568		if (objc != 2) {
569			Tcl_WrongNumArgs(interp, 1, objv, NULL);
570			return (TCL_ERROR);
571		}
572		_debug_check();
573		res = Tcl_NewIntObj((int)txnp->id(txnp));
574		break;
575	case TXNPREPARE:
576		if (objc != 3) {
577			Tcl_WrongNumArgs(interp, 1, objv, NULL);
578			return (TCL_ERROR);
579		}
580		_debug_check();
581		gid = (u_int8_t *)Tcl_GetByteArrayFromObj(objv[2], &length);
582		memcpy(garray, gid, (size_t)length);
583		ret = txnp->prepare(txnp, garray);
584		/*
585		 * !!!
586		 * DB_TXN->prepare commits all outstanding children.  But it
587		 * does NOT destroy the current txn handle.  So, we must call
588		 * _TxnInfoDelete to recursively remove all nested txn handles,
589		 * we do not call _DeleteInfo on ourselves.
590		 */
591		_TxnInfoDelete(interp, txnip);
592		result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
593		    "txn prepare");
594		break;
595	case TXNGETNAME:
596		if (objc != 2) {
597			Tcl_WrongNumArgs(interp, 2, objv, NULL);
598			return (TCL_ERROR);
599		}
600		_debug_check();
601		ret = txnp->get_name(txnp, &name);
602		if ((result = _ReturnSetup(
603		    interp, ret, DB_RETOK_STD(ret), "txn getname")) == TCL_OK)
604			res = NewStringObj(name, strlen(name));
605		break;
606	case TXNSETNAME:
607		if (objc != 3) {
608			Tcl_WrongNumArgs(interp, 2, objv, "name");
609			return (TCL_ERROR);
610		}
611		_debug_check();
612		ret = txnp->set_name(txnp, Tcl_GetStringFromObj(objv[2], NULL));
613		result =
614		    _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "setname");
615		break;
616#endif
617	case TXNABORT:
618		if (objc != 2) {
619			Tcl_WrongNumArgs(interp, 1, objv, NULL);
620			return (TCL_ERROR);
621		}
622		_debug_check();
623		ret = txnp->abort(txnp);
624		result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
625		    "txn abort");
626		_TxnInfoDelete(interp, txnip);
627		(void)Tcl_DeleteCommand(interp, txnip->i_name);
628		_DeleteInfo(txnip);
629		break;
630	case TXNCOMMIT:
631		result = tcl_TxnCommit(interp, objc, objv, txnp, txnip);
632		_TxnInfoDelete(interp, txnip);
633		(void)Tcl_DeleteCommand(interp, txnip->i_name);
634		_DeleteInfo(txnip);
635		break;
636	}
637	/*
638	 * Only set result if we have a res.  Otherwise, lower
639	 * functions have already done so.
640	 */
641	if (result == TCL_OK && res)
642		Tcl_SetObjResult(interp, res);
643	return (result);
644}
645
646static int
647tcl_TxnCommit(interp, objc, objv, txnp, txnip)
648	Tcl_Interp *interp;		/* Interpreter */
649	int objc;			/* How many arguments? */
650	Tcl_Obj *CONST objv[];		/* The argument objects */
651	DB_TXN *txnp;			/* Transaction pointer */
652	DBTCL_INFO *txnip;		/* Info pointer */
653{
654	static const char *commitopt[] = {
655		"-nosync",
656		"-sync",
657		"-wrnosync",
658		NULL
659	};
660	enum commitopt {
661		COMNOSYNC,
662		COMSYNC,
663		COMWRNOSYNC
664	};
665	u_int32_t flag;
666	int optindex, result, ret;
667
668	COMPQUIET(txnip, NULL);
669
670	result = TCL_OK;
671	flag = 0;
672	if (objc != 2 && objc != 3) {
673		Tcl_WrongNumArgs(interp, 1, objv, NULL);
674		return (TCL_ERROR);
675	}
676	if (objc == 3) {
677		if (Tcl_GetIndexFromObj(interp, objv[2], commitopt,
678		    "option", TCL_EXACT, &optindex) != TCL_OK)
679			return (IS_HELP(objv[2]));
680		switch ((enum commitopt)optindex) {
681		case COMSYNC:
682			flag = DB_TXN_SYNC;
683			break;
684		case COMNOSYNC:
685			flag = DB_TXN_NOSYNC;
686			break;
687		case COMWRNOSYNC:
688			flag = DB_TXN_WRITE_NOSYNC;
689			break;
690		}
691	}
692
693	_debug_check();
694	ret = txnp->commit(txnp, flag);
695	result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
696	    "txn commit");
697	return (result);
698}
699
700#ifdef CONFIG_TEST
701/*
702 * tcl_TxnRecover --
703 *
704 * PUBLIC: int tcl_TxnRecover __P((Tcl_Interp *, int,
705 * PUBLIC:    Tcl_Obj * CONST*, DB_ENV *, DBTCL_INFO *));
706 */
707int
708tcl_TxnRecover(interp, objc, objv, dbenv, envip)
709	Tcl_Interp *interp;		/* Interpreter */
710	int objc;			/* How many arguments? */
711	Tcl_Obj *CONST objv[];		/* The argument objects */
712	DB_ENV *dbenv;			/* Environment pointer */
713	DBTCL_INFO *envip;		/* Info pointer */
714{
715#define	DO_PREPLIST(count)						\
716for (i = 0; i < count; i++) {						\
717	snprintf(newname, sizeof(newname), "%s.txn%d",			\
718	    envip->i_name, envip->i_envtxnid);				\
719	ip = _NewInfo(interp, NULL, newname, I_TXN);			\
720	if (ip == NULL) {						\
721		Tcl_SetResult(interp, "Could not set up info",		\
722		    TCL_STATIC);					\
723		return (TCL_ERROR);					\
724	}								\
725	envip->i_envtxnid++;						\
726	ip->i_parent = envip;						\
727	p = &prep[i];							\
728	_SetInfoData(ip, p->txn);					\
729	(void)Tcl_CreateObjCommand(interp, newname,			\
730	    (Tcl_ObjCmdProc *)txn_Cmd, (ClientData)p->txn, NULL);	\
731	result = _SetListElem(interp, res, newname,			\
732	    (u_int32_t)strlen(newname), p->gid, DB_GID_SIZE);		\
733	if (result != TCL_OK)						\
734		goto error;						\
735}
736
737	DBTCL_INFO *ip;
738	DB_PREPLIST prep[DBTCL_PREP], *p;
739	Tcl_Obj *res;
740	u_int32_t count, i;
741	int result, ret;
742	char newname[MSG_SIZE];
743
744	result = TCL_OK;
745	/*
746	 * No args for this.  Error if there are some.
747	 */
748	if (objc != 2) {
749		Tcl_WrongNumArgs(interp, 2, objv, NULL);
750		return (TCL_ERROR);
751	}
752	_debug_check();
753	ret = dbenv->txn_recover(dbenv, prep, DBTCL_PREP, &count, DB_FIRST);
754	result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
755	    "txn recover");
756	if (result == TCL_ERROR)
757		return (result);
758	res = Tcl_NewObj();
759	DO_PREPLIST(count);
760
761	/*
762	 * If count returned is the maximum size we have, then there
763	 * might be more.  Keep going until we get them all.
764	 */
765	while (count == DBTCL_PREP) {
766		ret = dbenv->txn_recover(
767		    dbenv, prep, DBTCL_PREP, &count, DB_NEXT);
768		result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
769		    "txn recover");
770		if (result == TCL_ERROR)
771			return (result);
772		DO_PREPLIST(count);
773	}
774	Tcl_SetObjResult(interp, res);
775error:
776	return (result);
777}
778#endif
779