1 /*-
2  * Copyright (c) 1999, 2020 Oracle and/or its affiliates.  All rights reserved.
3  *
4  * See the file LICENSE for license information.
5  *
6  * $Id$
7  */
8 
9 #include "db_config.h"
10 #ifdef CONFIG_TEST
11 
12 #include "db_int.h"
13 #ifdef HAVE_SYSTEM_INCLUDE_FILES
14 #include <tcl.h>
15 #endif
16 #include "dbinc/tcl_db.h"
17 
18 /*
19  * bdb_HCommand --
20  *	Implements h* functions.
21  *
22  * PUBLIC: int bdb_HCommand __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
23  */
24 int
bdb_HCommand(interp,objc,objv)25 bdb_HCommand(interp, objc, objv)
26 	Tcl_Interp *interp;		/* Interpreter */
27 	int objc;			/* How many arguments? */
28 	Tcl_Obj *CONST objv[];		/* The argument objects */
29 {
30 	static const char *hcmds[] = {
31 		"hcreate",
32 		"hdestroy",
33 		"hsearch",
34 		NULL
35 	};
36 	enum hcmds {
37 		HHCREATE,
38 		HHDESTROY,
39 		HHSEARCH
40 	};
41 	static const char *srchacts[] = {
42 		"enter",
43 		"find",
44 		NULL
45 	};
46 	enum srchacts {
47 		ACT_ENTER,
48 		ACT_FIND
49 	};
50 	ENTRY item, *hres;
51 	ACTION action;
52 	int actindex, cmdindex, nelem, result, ret;
53 	Tcl_Obj *res;
54 
55 	result = TCL_OK;
56 	/*
57 	 * Get the command name index from the object based on the cmds
58 	 * defined above.  This SHOULD NOT fail because we already checked
59 	 * in the 'berkdb' command.
60 	 */
61 	if (Tcl_GetIndexFromObj(interp,
62 	    objv[1], hcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
63 		return (IS_HELP(objv[1]));
64 
65 	res = NULL;
66 	switch ((enum hcmds)cmdindex) {
67 	case HHCREATE:
68 		/*
69 		 * Must be 1 arg, nelem.  Error if not.
70 		 */
71 		if (objc != 3) {
72 			Tcl_WrongNumArgs(interp, 2, objv, "nelem");
73 			return (TCL_ERROR);
74 		}
75 		result = Tcl_GetIntFromObj(interp, objv[2], &nelem);
76 		if (result == TCL_OK) {
77 			_debug_check();
78 			ret = hcreate((size_t)nelem) == 0 ? 1: 0;
79 			(void)_ReturnSetup(
80 			    interp, ret, DB_RETOK_STD(ret), "hcreate");
81 		}
82 		break;
83 	case HHSEARCH:
84 		/*
85 		 * 3 args for this.  Error if different.
86 		 */
87 		if (objc != 5) {
88 			Tcl_WrongNumArgs(interp, 2, objv, "key data action");
89 			return (TCL_ERROR);
90 		}
91 		item.key = Tcl_GetStringFromObj(objv[2], NULL);
92 		item.data = Tcl_GetStringFromObj(objv[3], NULL);
93 		if (Tcl_GetIndexFromObj(interp, objv[4], srchacts,
94 		    "action", TCL_EXACT, &actindex) != TCL_OK)
95 			return (IS_HELP(objv[4]));
96 		switch ((enum srchacts)actindex) {
97 		case ACT_ENTER:
98 			action = ENTER;
99 			break;
100 		default:
101 		case ACT_FIND:
102 			action = FIND;
103 			break;
104 		}
105 		_debug_check();
106 		hres = hsearch(item, action);
107 		if (hres == NULL)
108 			Tcl_SetResult(interp, "-1", TCL_STATIC);
109 		else if (action == FIND)
110 			Tcl_SetResult(interp, (char *)hres->data, TCL_STATIC);
111 		else
112 			/* action is ENTER */
113 			Tcl_SetResult(interp, "0", TCL_STATIC);
114 
115 		break;
116 	case HHDESTROY:
117 		/*
118 		 * No args for this.  Error if there are some.
119 		 */
120 		if (objc != 2) {
121 			Tcl_WrongNumArgs(interp, 2, objv, NULL);
122 			return (TCL_ERROR);
123 		}
124 		_debug_check();
125 		hdestroy();
126 		res = Tcl_NewIntObj(0);
127 		break;
128 	}
129 	/*
130 	 * Only set result if we have a res.  Otherwise, lower
131 	 * functions have already done so.
132 	 */
133 	if (result == TCL_OK && res)
134 		Tcl_SetObjResult(interp, res);
135 	return (result);
136 }
137 
138 /*
139  *
140  * bdb_NdbmOpen --
141  *	Opens an ndbm database.
142  *
143  * PUBLIC: #if DB_DBM_HSEARCH != 0
144  * PUBLIC: int bdb_NdbmOpen __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DBM **));
145  * PUBLIC: #endif
146  */
147 int
bdb_NdbmOpen(interp,objc,objv,dbpp)148 bdb_NdbmOpen(interp, objc, objv, dbpp)
149 	Tcl_Interp *interp;		/* Interpreter */
150 	int objc;			/* How many arguments? */
151 	Tcl_Obj *CONST objv[];		/* The argument objects */
152 	DBM **dbpp;			/* Dbm pointer */
153 {
154 	static const char *ndbopen[] = {
155 		"-create",
156 		"-mode",
157 		"-rdonly",
158 		"-truncate",
159 		"--",
160 		NULL
161 	};
162 	enum ndbopen {
163 		NDB_CREATE,
164 		NDB_MODE,
165 		NDB_RDONLY,
166 		NDB_TRUNC,
167 		NDB_ENDARG
168 	};
169 
170 	int endarg, i, mode, open_flags, optindex, read_only, result, ret;
171 	char *arg, *db;
172 
173 	result = TCL_OK;
174 	endarg = mode = open_flags = read_only = 0;
175 
176 	if (objc < 2) {
177 		Tcl_WrongNumArgs(interp, 2, objv, "?args?");
178 		return (TCL_ERROR);
179 	}
180 
181 	/*
182 	 * Get the option name index from the object based on the args
183 	 * defined above.
184 	 */
185 	i = 2;
186 	while (i < objc) {
187 		if (Tcl_GetIndexFromObj(interp, objv[i], ndbopen, "option",
188 		    TCL_EXACT, &optindex) != TCL_OK) {
189 			arg = Tcl_GetStringFromObj(objv[i], NULL);
190 			if (arg[0] == '-') {
191 				result = IS_HELP(objv[i]);
192 				goto error;
193 			} else
194 				Tcl_ResetResult(interp);
195 			break;
196 		}
197 		i++;
198 		switch ((enum ndbopen)optindex) {
199 		case NDB_CREATE:
200 			open_flags |= O_CREAT;
201 			break;
202 		case NDB_RDONLY:
203 			read_only = 1;
204 			break;
205 		case NDB_TRUNC:
206 			open_flags |= O_TRUNC;
207 			break;
208 		case NDB_MODE:
209 			if (i >= objc) {
210 				Tcl_WrongNumArgs(interp, 2, objv,
211 				    "?-mode mode?");
212 				result = TCL_ERROR;
213 				break;
214 			}
215 			/*
216 			 * Don't need to check result here because
217 			 * if TCL_ERROR, the error message is already
218 			 * set up, and we'll bail out below.  If ok,
219 			 * the mode is set and we go on.
220 			 */
221 			result = Tcl_GetIntFromObj(interp, objv[i++], &mode);
222 			break;
223 		case NDB_ENDARG:
224 			endarg = 1;
225 			break;
226 		}
227 
228 		/*
229 		 * If, at any time, parsing the args we get an error,
230 		 * bail out and return.
231 		 */
232 		if (result != TCL_OK)
233 			goto error;
234 		if (endarg)
235 			break;
236 	}
237 	if (result != TCL_OK)
238 		goto error;
239 
240 	/*
241 	 * Any args we have left, (better be 0, or 1 left) is a
242 	 * file name.  If we have 0, then an in-memory db.  If
243 	 * there is 1, a db name.
244 	 */
245 	db = NULL;
246 	if (i != objc && i != objc - 1) {
247 		Tcl_WrongNumArgs(interp, 2, objv, "?args? ?file?");
248 		result = TCL_ERROR;
249 		goto error;
250 	}
251 	if (i != objc)
252 		db = Tcl_GetStringFromObj(objv[objc - 1], NULL);
253 
254 	/*
255 	 * When we get here, we have already parsed all of our args
256 	 * and made all our calls to set up the database.  Everything
257 	 * is okay so far, no errors, if we get here.
258 	 *
259 	 * Now open the database.
260 	 */
261 	if (read_only)
262 		open_flags |= O_RDONLY;
263 	else
264 		open_flags |= O_RDWR;
265 	_debug_check();
266 	if ((*dbpp = dbm_open(db, open_flags, mode)) == NULL) {
267 		ret = Tcl_GetErrno();
268 		result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
269 		    "db open");
270 		goto error;
271 	}
272 	return (TCL_OK);
273 
274 error:
275 	*dbpp = NULL;
276 	return (result);
277 }
278 
279 /*
280  * bdb_DbmCommand --
281  *	Implements "dbm" commands.
282  *
283  * PUBLIC: #if DB_DBM_HSEARCH != 0
284  * PUBLIC: int bdb_DbmCommand
285  * PUBLIC:     __P((Tcl_Interp *, int, Tcl_Obj * CONST*, int, DBM *));
286  * PUBLIC: #endif
287  */
288 int
bdb_DbmCommand(interp,objc,objv,flag,dbm)289 bdb_DbmCommand(interp, objc, objv, flag, dbm)
290 	Tcl_Interp *interp;		/* Interpreter */
291 	int objc;			/* How many arguments? */
292 	Tcl_Obj *CONST objv[];		/* The argument objects */
293 	int flag;			/* Which db interface */
294 	DBM *dbm;			/* DBM pointer */
295 {
296 	static const char *dbmcmds[] = {
297 		"dbmclose",
298 		"dbminit",
299 		"delete",
300 		"fetch",
301 		"firstkey",
302 		"nextkey",
303 		"store",
304 		NULL
305 	};
306 	enum dbmcmds {
307 		DBMCLOSE,
308 		DBMINIT,
309 		DBMDELETE,
310 		DBMFETCH,
311 		DBMFIRST,
312 		DBMNEXT,
313 		DBMSTORE
314 	};
315 	static const char *stflag[] = {
316 		"insert",	"replace",
317 		NULL
318 	};
319 	enum stflag {
320 		STINSERT,	STREPLACE
321 	};
322 	datum key, data;
323 	void *dtmp, *ktmp;
324 	u_int32_t size;
325 	int cmdindex, freedata, freekey, stindex, result, ret;
326 	char *name, *t;
327 
328 	result = TCL_OK;
329 	freekey = freedata = 0;
330 	dtmp = ktmp = NULL;
331 
332 	/*
333 	 * Get the command name index from the object based on the cmds
334 	 * defined above.  This SHOULD NOT fail because we already checked
335 	 * in the 'berkdb' command.
336 	 */
337 	if (Tcl_GetIndexFromObj(interp,
338 	    objv[1], dbmcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
339 		return (IS_HELP(objv[1]));
340 
341 	switch ((enum dbmcmds)cmdindex) {
342 	case DBMCLOSE:
343 		/*
344 		 * No arg for this.  Error if different.
345 		 */
346 		if (objc != 2) {
347 			Tcl_WrongNumArgs(interp, 2, objv, NULL);
348 			return (TCL_ERROR);
349 		}
350 		_debug_check();
351 		if (flag == DBTCL_DBM)
352 			ret = dbmclose();
353 		else {
354 			Tcl_SetResult(interp,
355 			    "Bad interface flag for command", TCL_STATIC);
356 			return (TCL_ERROR);
357 		}
358 		(void)_ReturnSetup(interp, ret, DB_RETOK_STD(ret), "dbmclose");
359 		break;
360 	case DBMINIT:
361 		/*
362 		 * Must be 1 arg - file.
363 		 */
364 		if (objc != 3) {
365 			Tcl_WrongNumArgs(interp, 2, objv, "file");
366 			return (TCL_ERROR);
367 		}
368 		name = Tcl_GetStringFromObj(objv[2], NULL);
369 		if (flag == DBTCL_DBM)
370 			ret = dbminit(name);
371 		else {
372 			Tcl_SetResult(interp, "Bad interface flag for command",
373 			    TCL_STATIC);
374 			return (TCL_ERROR);
375 		}
376 		(void)_ReturnSetup(interp, ret, DB_RETOK_STD(ret), "dbminit");
377 		break;
378 	case DBMFETCH:
379 		/*
380 		 * 1 arg for this.  Error if different.
381 		 */
382 		if (objc != 3) {
383 			Tcl_WrongNumArgs(interp, 2, objv, "key");
384 			return (TCL_ERROR);
385 		}
386 		if ((ret = _CopyObjBytes(
387 		    interp, objv[2], &ktmp, &size, &freekey)) != 0) {
388 			result = _ReturnSetup(interp, ret,
389 			    DB_RETOK_STD(ret), "dbm fetch");
390 			goto out;
391 		}
392 		key.dsize = (int)size;
393 		key.dptr = (char *)ktmp;
394 		_debug_check();
395 		if (flag == DBTCL_DBM)
396 			data = fetch(key);
397 		else if (flag == DBTCL_NDBM)
398 			data = dbm_fetch(dbm, key);
399 		else {
400 			Tcl_SetResult(interp,
401 			    "Bad interface flag for command", TCL_STATIC);
402 			result = TCL_ERROR;
403 			goto out;
404 		}
405 		if (data.dptr == NULL ||
406 		    (ret = __os_malloc(NULL, (size_t)data.dsize + 1, &t)) != 0)
407 			Tcl_SetResult(interp, "-1", TCL_STATIC);
408 		else {
409 			memcpy(t, data.dptr, (size_t)data.dsize);
410 			t[data.dsize] = '\0';
411 			Tcl_SetResult(interp, t, TCL_VOLATILE);
412 			__os_free(NULL, t);
413 		}
414 		break;
415 	case DBMSTORE:
416 		/*
417 		 * 2 args for this.  Error if different.
418 		 */
419 		if (objc != 4 && flag == DBTCL_DBM) {
420 			Tcl_WrongNumArgs(interp, 2, objv, "key data");
421 			return (TCL_ERROR);
422 		}
423 		if (objc != 5 && flag == DBTCL_NDBM) {
424 			Tcl_WrongNumArgs(interp, 2, objv, "key data action");
425 			return (TCL_ERROR);
426 		}
427 		if ((ret = _CopyObjBytes(
428 		    interp, objv[2], &ktmp, &size, &freekey)) != 0) {
429 			result = _ReturnSetup(interp, ret,
430 			    DB_RETOK_STD(ret), "dbm fetch");
431 			goto out;
432 		}
433 		key.dsize = (int)size;
434 		key.dptr = (char *)ktmp;
435 		if ((ret = _CopyObjBytes(
436 		    interp, objv[3], &dtmp, &size, &freedata)) != 0) {
437 			result = _ReturnSetup(interp, ret,
438 			    DB_RETOK_STD(ret), "dbm fetch");
439 			goto out;
440 		}
441 		data.dsize = (int)size;
442 		data.dptr = (char *)dtmp;
443 		_debug_check();
444 		if (flag == DBTCL_DBM)
445 			ret = store(key, data);
446 		else if (flag == DBTCL_NDBM) {
447 			if (Tcl_GetIndexFromObj(interp, objv[4], stflag,
448 			    "flag", TCL_EXACT, &stindex) != TCL_OK)
449 				return (IS_HELP(objv[4]));
450 			switch ((enum stflag)stindex) {
451 			case STINSERT:
452 				flag = DBM_INSERT;
453 				break;
454 			case STREPLACE:
455 				flag = DBM_REPLACE;
456 				break;
457 			}
458 			ret = dbm_store(dbm, key, data, flag);
459 		} else {
460 			Tcl_SetResult(interp,
461 			    "Bad interface flag for command", TCL_STATIC);
462 			return (TCL_ERROR);
463 		}
464 		(void)_ReturnSetup(interp, ret, DB_RETOK_STD(ret), "store");
465 		break;
466 	case DBMDELETE:
467 		/*
468 		 * 1 arg for this.  Error if different.
469 		 */
470 		if (objc != 3) {
471 			Tcl_WrongNumArgs(interp, 2, objv, "key");
472 			return (TCL_ERROR);
473 		}
474 		if ((ret = _CopyObjBytes(
475 		    interp, objv[2], &ktmp, &size, &freekey)) != 0) {
476 			result = _ReturnSetup(interp, ret,
477 			    DB_RETOK_STD(ret), "dbm fetch");
478 			goto out;
479 		}
480 		key.dsize = (int)size;
481 		key.dptr = (char *)ktmp;
482 		_debug_check();
483 		if (flag == DBTCL_DBM)
484 			ret = delete(key);
485 		else if (flag == DBTCL_NDBM)
486 			ret = dbm_delete(dbm, key);
487 		else {
488 			Tcl_SetResult(interp,
489 			    "Bad interface flag for command", TCL_STATIC);
490 			return (TCL_ERROR);
491 		}
492 		(void)_ReturnSetup(interp, ret, DB_RETOK_STD(ret), "delete");
493 		break;
494 	case DBMFIRST:
495 		/*
496 		 * No arg for this.  Error if different.
497 		 */
498 		if (objc != 2) {
499 			Tcl_WrongNumArgs(interp, 2, objv, NULL);
500 			return (TCL_ERROR);
501 		}
502 		_debug_check();
503 		if (flag == DBTCL_DBM)
504 			key = firstkey();
505 		else if (flag == DBTCL_NDBM)
506 			key = dbm_firstkey(dbm);
507 		else {
508 			Tcl_SetResult(interp,
509 			    "Bad interface flag for command", TCL_STATIC);
510 			return (TCL_ERROR);
511 		}
512 		if (key.dptr == NULL ||
513 		    (ret = __os_malloc(NULL, (size_t)key.dsize + 1, &t)) != 0)
514 			Tcl_SetResult(interp, "-1", TCL_STATIC);
515 		else {
516 			memcpy(t, key.dptr, (size_t)key.dsize);
517 			t[key.dsize] = '\0';
518 			Tcl_SetResult(interp, t, TCL_VOLATILE);
519 			__os_free(NULL, t);
520 		}
521 		break;
522 	case DBMNEXT:
523 		/*
524 		 * 0 or 1 arg for this.  Error if different.
525 		 */
526 		_debug_check();
527 		if (flag == DBTCL_DBM) {
528 			if (objc != 3) {
529 				Tcl_WrongNumArgs(interp, 2, objv, NULL);
530 				return (TCL_ERROR);
531 			}
532 			if ((ret = _CopyObjBytes(
533 			    interp, objv[2], &ktmp, &size, &freekey)) != 0) {
534 				result = _ReturnSetup(interp, ret,
535 				    DB_RETOK_STD(ret), "dbm fetch");
536 				goto out;
537 			}
538 			key.dsize = (int)size;
539 			key.dptr = (char *)ktmp;
540 			data = nextkey(key);
541 		} else if (flag == DBTCL_NDBM) {
542 			if (objc != 2) {
543 				Tcl_WrongNumArgs(interp, 2, objv, NULL);
544 				return (TCL_ERROR);
545 			}
546 			data = dbm_nextkey(dbm);
547 		} else {
548 			Tcl_SetResult(interp,
549 			    "Bad interface flag for command", TCL_STATIC);
550 			return (TCL_ERROR);
551 		}
552 		if (data.dptr == NULL ||
553 		    (ret = __os_malloc(NULL, (size_t)data.dsize + 1, &t)) != 0)
554 			Tcl_SetResult(interp, "-1", TCL_STATIC);
555 		else {
556 			memcpy(t, data.dptr, (size_t)data.dsize);
557 			t[data.dsize] = '\0';
558 			Tcl_SetResult(interp, t, TCL_VOLATILE);
559 			__os_free(NULL, t);
560 		}
561 		break;
562 	}
563 
564 out:	if (dtmp != NULL && freedata)
565 		__os_free(NULL, dtmp);
566 	if (ktmp != NULL && freekey)
567 		__os_free(NULL, ktmp);
568 	return (result);
569 }
570 
571 /*
572  * ndbm_Cmd --
573  *	Implements the "ndbm" widget.
574  *
575  * PUBLIC: int ndbm_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*));
576  */
577 int
ndbm_Cmd(clientData,interp,objc,objv)578 ndbm_Cmd(clientData, interp, objc, objv)
579 	ClientData clientData;		/* DB handle */
580 	Tcl_Interp *interp;		/* Interpreter */
581 	int objc;			/* How many arguments? */
582 	Tcl_Obj *CONST objv[];		/* The argument objects */
583 {
584 	static const char *ndbcmds[] = {
585 		"clearerr",
586 		"close",
587 		"delete",
588 		"dirfno",
589 		"error",
590 		"fetch",
591 		"firstkey",
592 		"nextkey",
593 		"pagfno",
594 		"rdonly",
595 		"store",
596 		NULL
597 	};
598 	enum ndbcmds {
599 		NDBCLRERR,
600 		NDBCLOSE,
601 		NDBDELETE,
602 		NDBDIRFNO,
603 		NDBERR,
604 		NDBFETCH,
605 		NDBFIRST,
606 		NDBNEXT,
607 		NDBPAGFNO,
608 		NDBRDONLY,
609 		NDBSTORE
610 	};
611 	DBM *dbp;
612 	DBTCL_INFO *dbip;
613 	Tcl_Obj *res;
614 	int cmdindex, result, ret;
615 
616 	Tcl_ResetResult(interp);
617 	dbp = (DBM *)clientData;
618 	dbip = _PtrToInfo((void *)dbp);
619 	result = TCL_OK;
620 	if (objc <= 1) {
621 		Tcl_WrongNumArgs(interp, 1, objv, "command cmdargs");
622 		return (TCL_ERROR);
623 	}
624 	if (dbp == NULL) {
625 		Tcl_SetResult(interp, "NULL db pointer", TCL_STATIC);
626 		return (TCL_ERROR);
627 	}
628 	if (dbip == NULL) {
629 		Tcl_SetResult(interp, "NULL db info pointer", TCL_STATIC);
630 		return (TCL_ERROR);
631 	}
632 
633 	/*
634 	 * Get the command name index from the object based on the dbcmds
635 	 * defined above.
636 	 */
637 	if (Tcl_GetIndexFromObj(interp,
638 	    objv[1], ndbcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
639 		return (IS_HELP(objv[1]));
640 
641 	res = NULL;
642 	switch ((enum ndbcmds)cmdindex) {
643 	case NDBCLOSE:
644 		_debug_check();
645 		dbm_close(dbp);
646 		(void)Tcl_DeleteCommand(interp, dbip->i_name);
647 		_DeleteInfo(dbip);
648 		res = Tcl_NewIntObj(0);
649 		break;
650 	case NDBDELETE:
651 	case NDBFETCH:
652 	case NDBFIRST:
653 	case NDBNEXT:
654 	case NDBSTORE:
655 		result = bdb_DbmCommand(interp, objc, objv, DBTCL_NDBM, dbp);
656 		break;
657 	case NDBCLRERR:
658 		/*
659 		 * No args for this.  Error if there are some.
660 		 */
661 		if (objc > 2) {
662 			Tcl_WrongNumArgs(interp, 2, objv, NULL);
663 			return (TCL_ERROR);
664 		}
665 		_debug_check();
666 		ret = dbm_clearerr(dbp);
667 		if (ret)
668 			(void)_ReturnSetup(
669 			    interp, ret, DB_RETOK_STD(ret), "clearerr");
670 		else
671 			res = Tcl_NewIntObj(ret);
672 		break;
673 	case NDBDIRFNO:
674 		/*
675 		 * No args for this.  Error if there are some.
676 		 */
677 		if (objc > 2) {
678 			Tcl_WrongNumArgs(interp, 2, objv, NULL);
679 			return (TCL_ERROR);
680 		}
681 		_debug_check();
682 		ret = dbm_dirfno(dbp);
683 		res = Tcl_NewIntObj(ret);
684 		break;
685 	case NDBPAGFNO:
686 		/*
687 		 * No args for this.  Error if there are some.
688 		 */
689 		if (objc > 2) {
690 			Tcl_WrongNumArgs(interp, 2, objv, NULL);
691 			return (TCL_ERROR);
692 		}
693 		_debug_check();
694 		ret = dbm_pagfno(dbp);
695 		res = Tcl_NewIntObj(ret);
696 		break;
697 	case NDBERR:
698 		/*
699 		 * No args for this.  Error if there are some.
700 		 */
701 		if (objc > 2) {
702 			Tcl_WrongNumArgs(interp, 2, objv, NULL);
703 			return (TCL_ERROR);
704 		}
705 		_debug_check();
706 		ret = dbm_error(dbp);
707 		Tcl_SetErrno(ret);
708 		Tcl_SetResult(interp,
709 		    (char *)Tcl_PosixError(interp), TCL_STATIC);
710 		break;
711 	case NDBRDONLY:
712 		/*
713 		 * No args for this.  Error if there are some.
714 		 */
715 		if (objc > 2) {
716 			Tcl_WrongNumArgs(interp, 2, objv, NULL);
717 			return (TCL_ERROR);
718 		}
719 		_debug_check();
720 		ret = dbm_rdonly(dbp);
721 		if (ret)
722 			(void)_ReturnSetup(
723 			    interp, ret, DB_RETOK_STD(ret), "rdonly");
724 		else
725 			res = Tcl_NewIntObj(ret);
726 		break;
727 	}
728 
729 	/*
730 	 * Only set result if we have a res.  Otherwise, lower functions have
731 	 * already done so.
732 	 */
733 	if (result == TCL_OK && res)
734 		Tcl_SetObjResult(interp, res);
735 	return (result);
736 }
737 #endif /* CONFIG_TEST */
738