1 /*-
2 * See the file LICENSE for redistribution information.
3 *
4 * Copyright (c) 1999, 2013 Oracle and/or its affiliates. All rights reserved.
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