1/*- 2 * See the file LICENSE for redistribution information. 3 * 4 * Copyright (c) 1999,2008 Oracle. All rights reserved. 5 * 6 * $Id: tcl_db.c,v 12.37 2008/02/19 17:01:58 bostic Exp $ 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/db_page.h" 16#include "dbinc/db_am.h" 17#include "dbinc/tcl_db.h" 18 19/* 20 * Prototypes for procedures defined later in this file: 21 */ 22static int tcl_DbAssociate __P((Tcl_Interp *, 23 int, Tcl_Obj * CONST*, DB *)); 24static int tcl_DbClose __P((Tcl_Interp *, 25 int, Tcl_Obj * CONST*, DB *, DBTCL_INFO *)); 26static int tcl_DbDelete __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *)); 27static int tcl_DbGet __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *, int)); 28#ifdef CONFIG_TEST 29static int tcl_DbKeyRange __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *)); 30#endif 31static int tcl_DbPut __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *)); 32static int tcl_DbStat __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *)); 33static int tcl_DbTruncate __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *)); 34#ifdef CONFIG_TEST 35static int tcl_DbCompact __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *)); 36static int tcl_DbCompactStat __P((Tcl_Interp *, 37 int, Tcl_Obj * CONST*, DB *)); 38#endif 39static int tcl_DbCursor __P((Tcl_Interp *, 40 int, Tcl_Obj * CONST*, DB *, DBC **)); 41static int tcl_DbJoin __P((Tcl_Interp *, 42 int, Tcl_Obj * CONST*, DB *, DBC **)); 43static int tcl_DbGetFlags __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *)); 44static int tcl_DbGetOpenFlags __P((Tcl_Interp *, 45 int, Tcl_Obj * CONST*, DB *)); 46static int tcl_DbGetjoin __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *)); 47static int tcl_DbCount __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *)); 48static int tcl_second_call __P((DB *, const DBT *, const DBT *, DBT *)); 49 50/* 51 * _DbInfoDelete -- 52 * 53 * PUBLIC: void _DbInfoDelete __P((Tcl_Interp *, DBTCL_INFO *)); 54 */ 55void 56_DbInfoDelete(interp, dbip) 57 Tcl_Interp *interp; 58 DBTCL_INFO *dbip; 59{ 60 DBTCL_INFO *nextp, *p; 61 /* 62 * First we have to close any open cursors. Then we close 63 * our db. 64 */ 65 for (p = LIST_FIRST(&__db_infohead); p != NULL; p = nextp) { 66 nextp = LIST_NEXT(p, entries); 67 /* 68 * Check if this is a cursor info structure and if 69 * it is, if it belongs to this DB. If so, remove 70 * its commands and info structure. 71 */ 72 if (p->i_parent == dbip && p->i_type == I_DBC) { 73 (void)Tcl_DeleteCommand(interp, p->i_name); 74 _DeleteInfo(p); 75 } 76 } 77 (void)Tcl_DeleteCommand(interp, dbip->i_name); 78 _DeleteInfo(dbip); 79} 80 81/* 82 * 83 * PUBLIC: int db_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*)); 84 * 85 * db_Cmd -- 86 * Implements the "db" widget. 87 */ 88int 89db_Cmd(clientData, interp, objc, objv) 90 ClientData clientData; /* DB handle */ 91 Tcl_Interp *interp; /* Interpreter */ 92 int objc; /* How many arguments? */ 93 Tcl_Obj *CONST objv[]; /* The argument objects */ 94{ 95 static const char *dbcmds[] = { 96#ifdef CONFIG_TEST 97 "keyrange", 98 "pget", 99 "rpcid", 100 "test", 101 "compact", 102 "compact_stat", 103#endif 104 "associate", 105 "close", 106 "count", 107 "cursor", 108 "del", 109 "get", 110 "get_bt_minkey", 111 "get_cachesize", 112 "get_dbname", 113 "get_encrypt_flags", 114 "get_env", 115 "get_errpfx", 116 "get_flags", 117 "get_h_ffactor", 118 "get_h_nelem", 119 "get_join", 120 "get_lorder", 121 "get_open_flags", 122 "get_pagesize", 123 "get_q_extentsize", 124 "get_re_delim", 125 "get_re_len", 126 "get_re_pad", 127 "get_re_source", 128 "get_type", 129 "is_byteswapped", 130 "join", 131 "put", 132 "stat", 133 "sync", 134 "truncate", 135 NULL 136 }; 137 enum dbcmds { 138#ifdef CONFIG_TEST 139 DBKEYRANGE, 140 DBPGET, 141 DBRPCID, 142 DBTEST, 143 DBCOMPACT, 144 DBCOMPACT_STAT, 145#endif 146 DBASSOCIATE, 147 DBCLOSE, 148 DBCOUNT, 149 DBCURSOR, 150 DBDELETE, 151 DBGET, 152 DBGETBTMINKEY, 153 DBGETCACHESIZE, 154 DBGETDBNAME, 155 DBGETENCRYPTFLAGS, 156 DBGETENV, 157 DBGETERRPFX, 158 DBGETFLAGS, 159 DBGETHFFACTOR, 160 DBGETHNELEM, 161 DBGETJOIN, 162 DBGETLORDER, 163 DBGETOPENFLAGS, 164 DBGETPAGESIZE, 165 DBGETQEXTENTSIZE, 166 DBGETREDELIM, 167 DBGETRELEN, 168 DBGETREPAD, 169 DBGETRESOURCE, 170 DBGETTYPE, 171 DBSWAPPED, 172 DBJOIN, 173 DBPUT, 174 DBSTAT, 175 DBSYNC, 176 DBTRUNCATE 177 }; 178 DB *dbp; 179 DB_ENV *dbenv; 180 DBC *dbc; 181 DBTCL_INFO *dbip, *ip; 182 DBTYPE type; 183 Tcl_Obj *res, *myobjv[3]; 184 int cmdindex, intval, ncache, result, ret; 185 char newname[MSG_SIZE]; 186 u_int32_t bytes, gbytes, value; 187 const char *strval, *filename, *dbname, *envid; 188 189 Tcl_ResetResult(interp); 190 dbp = (DB *)clientData; 191 dbip = _PtrToInfo((void *)dbp); 192 memset(newname, 0, MSG_SIZE); 193 result = TCL_OK; 194 if (objc <= 1) { 195 Tcl_WrongNumArgs(interp, 1, objv, "command cmdargs"); 196 return (TCL_ERROR); 197 } 198 if (dbp == NULL) { 199 Tcl_SetResult(interp, "NULL db pointer", TCL_STATIC); 200 return (TCL_ERROR); 201 } 202 if (dbip == NULL) { 203 Tcl_SetResult(interp, "NULL db info pointer", TCL_STATIC); 204 return (TCL_ERROR); 205 } 206 207 /* 208 * Get the command name index from the object based on the dbcmds 209 * defined above. 210 */ 211 if (Tcl_GetIndexFromObj(interp, 212 objv[1], dbcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK) 213 return (IS_HELP(objv[1])); 214 215 res = NULL; 216 switch ((enum dbcmds)cmdindex) { 217#ifdef CONFIG_TEST 218 case DBKEYRANGE: 219 result = tcl_DbKeyRange(interp, objc, objv, dbp); 220 break; 221 case DBPGET: 222 result = tcl_DbGet(interp, objc, objv, dbp, 1); 223 break; 224 case DBRPCID: 225 /* 226 * No args for this. Error if there are some. 227 */ 228 if (objc > 2) { 229 Tcl_WrongNumArgs(interp, 2, objv, NULL); 230 return (TCL_ERROR); 231 } 232 /* 233 * !!! Retrieve the client ID from the dbp handle directly. 234 * This is for testing purposes only. It is dbp-private data. 235 */ 236 res = Tcl_NewLongObj((long)dbp->cl_id); 237 break; 238 case DBTEST: 239 result = tcl_EnvTest(interp, objc, objv, dbp->dbenv); 240 break; 241 242 case DBCOMPACT: 243 result = tcl_DbCompact(interp, objc, objv, dbp); 244 break; 245 246 case DBCOMPACT_STAT: 247 result = tcl_DbCompactStat(interp, objc, objv, dbp); 248 break; 249 250#endif 251 case DBASSOCIATE: 252 result = tcl_DbAssociate(interp, objc, objv, dbp); 253 break; 254 case DBCLOSE: 255 result = tcl_DbClose(interp, objc, objv, dbp, dbip); 256 break; 257 case DBDELETE: 258 result = tcl_DbDelete(interp, objc, objv, dbp); 259 break; 260 case DBGET: 261 result = tcl_DbGet(interp, objc, objv, dbp, 0); 262 break; 263 case DBPUT: 264 result = tcl_DbPut(interp, objc, objv, dbp); 265 break; 266 case DBCOUNT: 267 result = tcl_DbCount(interp, objc, objv, dbp); 268 break; 269 case DBSWAPPED: 270 /* 271 * No args for this. Error if there are some. 272 */ 273 if (objc > 2) { 274 Tcl_WrongNumArgs(interp, 2, objv, NULL); 275 return (TCL_ERROR); 276 } 277 _debug_check(); 278 ret = dbp->get_byteswapped(dbp, &intval); 279 res = Tcl_NewIntObj(intval); 280 break; 281 case DBGETTYPE: 282 /* 283 * No args for this. Error if there are some. 284 */ 285 if (objc > 2) { 286 Tcl_WrongNumArgs(interp, 2, objv, NULL); 287 return (TCL_ERROR); 288 } 289 _debug_check(); 290 ret = dbp->get_type(dbp, &type); 291 if (type == DB_BTREE) 292 res = NewStringObj("btree", strlen("btree")); 293 else if (type == DB_HASH) 294 res = NewStringObj("hash", strlen("hash")); 295 else if (type == DB_RECNO) 296 res = NewStringObj("recno", strlen("recno")); 297 else if (type == DB_QUEUE) 298 res = NewStringObj("queue", strlen("queue")); 299 else { 300 Tcl_SetResult(interp, 301 "db gettype: Returned unknown type\n", TCL_STATIC); 302 result = TCL_ERROR; 303 } 304 break; 305 case DBSTAT: 306 result = tcl_DbStat(interp, objc, objv, dbp); 307 break; 308 case DBSYNC: 309 /* 310 * No args for this. Error if there are some. 311 */ 312 if (objc > 2) { 313 Tcl_WrongNumArgs(interp, 2, objv, NULL); 314 return (TCL_ERROR); 315 } 316 _debug_check(); 317 ret = dbp->sync(dbp, 0); 318 res = Tcl_NewIntObj(ret); 319 if (ret != 0) { 320 Tcl_SetObjResult(interp, res); 321 result = TCL_ERROR; 322 } 323 break; 324 case DBCURSOR: 325 snprintf(newname, sizeof(newname), 326 "%s.c%d", dbip->i_name, dbip->i_dbdbcid); 327 ip = _NewInfo(interp, NULL, newname, I_DBC); 328 if (ip != NULL) { 329 result = tcl_DbCursor(interp, objc, objv, dbp, &dbc); 330 if (result == TCL_OK) { 331 dbip->i_dbdbcid++; 332 ip->i_parent = dbip; 333 (void)Tcl_CreateObjCommand(interp, newname, 334 (Tcl_ObjCmdProc *)dbc_Cmd, 335 (ClientData)dbc, NULL); 336 res = NewStringObj(newname, strlen(newname)); 337 _SetInfoData(ip, dbc); 338 } else 339 _DeleteInfo(ip); 340 } else { 341 Tcl_SetResult(interp, 342 "Could not set up info", TCL_STATIC); 343 result = TCL_ERROR; 344 } 345 break; 346 case DBJOIN: 347 snprintf(newname, sizeof(newname), 348 "%s.c%d", dbip->i_name, dbip->i_dbdbcid); 349 ip = _NewInfo(interp, NULL, newname, I_DBC); 350 if (ip != NULL) { 351 result = tcl_DbJoin(interp, objc, objv, dbp, &dbc); 352 if (result == TCL_OK) { 353 dbip->i_dbdbcid++; 354 ip->i_parent = dbip; 355 (void)Tcl_CreateObjCommand(interp, newname, 356 (Tcl_ObjCmdProc *)dbc_Cmd, 357 (ClientData)dbc, NULL); 358 res = NewStringObj(newname, strlen(newname)); 359 _SetInfoData(ip, dbc); 360 } else 361 _DeleteInfo(ip); 362 } else { 363 Tcl_SetResult(interp, 364 "Could not set up info", TCL_STATIC); 365 result = TCL_ERROR; 366 } 367 break; 368 case DBGETBTMINKEY: 369 if (objc != 2) { 370 Tcl_WrongNumArgs(interp, 1, objv, NULL); 371 return (TCL_ERROR); 372 } 373 ret = dbp->get_bt_minkey(dbp, &value); 374 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 375 "db get_bt_minkey")) == TCL_OK) 376 res = Tcl_NewIntObj((int)value); 377 break; 378 case DBGETCACHESIZE: 379 if (objc != 2) { 380 Tcl_WrongNumArgs(interp, 1, objv, NULL); 381 return (TCL_ERROR); 382 } 383 ret = dbp->get_cachesize(dbp, &gbytes, &bytes, &ncache); 384 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 385 "db get_cachesize")) == TCL_OK) { 386 myobjv[0] = Tcl_NewIntObj((int)gbytes); 387 myobjv[1] = Tcl_NewIntObj((int)bytes); 388 myobjv[2] = Tcl_NewIntObj((int)ncache); 389 res = Tcl_NewListObj(3, myobjv); 390 } 391 break; 392 case DBGETDBNAME: 393 if (objc != 2) { 394 Tcl_WrongNumArgs(interp, 1, objv, NULL); 395 return (TCL_ERROR); 396 } 397 ret = dbp->get_dbname(dbp, &filename, &dbname); 398 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 399 "db get_dbname")) == TCL_OK) { 400 myobjv[0] = NewStringObj(filename, strlen(filename)); 401 myobjv[1] = NewStringObj(dbname, strlen(dbname)); 402 res = Tcl_NewListObj(2, myobjv); 403 } 404 break; 405 case DBGETENCRYPTFLAGS: 406 result = tcl_EnvGetEncryptFlags(interp, objc, objv, dbp->dbenv); 407 break; 408 case DBGETENV: 409 if (objc != 2) { 410 Tcl_WrongNumArgs(interp, 1, objv, NULL); 411 return (TCL_ERROR); 412 } 413 dbenv = dbp->get_env(dbp); 414 if (dbenv != NULL && (ip = _PtrToInfo(dbenv)) != NULL) { 415 envid = ip->i_name; 416 res = NewStringObj(envid, strlen(envid)); 417 } else 418 Tcl_ResetResult(interp); 419 break; 420 case DBGETERRPFX: 421 if (objc != 2) { 422 Tcl_WrongNumArgs(interp, 1, objv, NULL); 423 return (TCL_ERROR); 424 } 425 dbp->get_errpfx(dbp, &strval); 426 res = NewStringObj(strval, strlen(strval)); 427 break; 428 case DBGETFLAGS: 429 result = tcl_DbGetFlags(interp, objc, objv, dbp); 430 break; 431 case DBGETHFFACTOR: 432 if (objc != 2) { 433 Tcl_WrongNumArgs(interp, 1, objv, NULL); 434 return (TCL_ERROR); 435 } 436 ret = dbp->get_h_ffactor(dbp, &value); 437 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 438 "db get_h_ffactor")) == TCL_OK) 439 res = Tcl_NewIntObj((int)value); 440 break; 441 case DBGETHNELEM: 442 if (objc != 2) { 443 Tcl_WrongNumArgs(interp, 1, objv, NULL); 444 return (TCL_ERROR); 445 } 446 ret = dbp->get_h_nelem(dbp, &value); 447 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 448 "db get_h_nelem")) == TCL_OK) 449 res = Tcl_NewIntObj((int)value); 450 break; 451 case DBGETJOIN: 452 result = tcl_DbGetjoin(interp, objc, objv, dbp); 453 break; 454 case DBGETLORDER: 455 /* 456 * No args for this. Error if there are some. 457 */ 458 if (objc > 2) { 459 Tcl_WrongNumArgs(interp, 2, objv, NULL); 460 return (TCL_ERROR); 461 } 462 _debug_check(); 463 ret = dbp->get_lorder(dbp, &intval); 464 res = Tcl_NewIntObj(intval); 465 break; 466 case DBGETOPENFLAGS: 467 result = tcl_DbGetOpenFlags(interp, objc, objv, dbp); 468 break; 469 case DBGETPAGESIZE: 470 if (objc != 2) { 471 Tcl_WrongNumArgs(interp, 1, objv, NULL); 472 return (TCL_ERROR); 473 } 474 ret = dbp->get_pagesize(dbp, &value); 475 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 476 "db get_pagesize")) == TCL_OK) 477 res = Tcl_NewIntObj((int)value); 478 break; 479 case DBGETQEXTENTSIZE: 480 if (objc != 2) { 481 Tcl_WrongNumArgs(interp, 1, objv, NULL); 482 return (TCL_ERROR); 483 } 484 ret = dbp->get_q_extentsize(dbp, &value); 485 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 486 "db get_q_extentsize")) == TCL_OK) 487 res = Tcl_NewIntObj((int)value); 488 break; 489 case DBGETREDELIM: 490 if (objc != 2) { 491 Tcl_WrongNumArgs(interp, 1, objv, NULL); 492 return (TCL_ERROR); 493 } 494 ret = dbp->get_re_delim(dbp, &intval); 495 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 496 "db get_re_delim")) == TCL_OK) 497 res = Tcl_NewIntObj(intval); 498 break; 499 case DBGETRELEN: 500 if (objc != 2) { 501 Tcl_WrongNumArgs(interp, 1, objv, NULL); 502 return (TCL_ERROR); 503 } 504 ret = dbp->get_re_len(dbp, &value); 505 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 506 "db get_re_len")) == TCL_OK) 507 res = Tcl_NewIntObj((int)value); 508 break; 509 case DBGETREPAD: 510 if (objc != 2) { 511 Tcl_WrongNumArgs(interp, 1, objv, NULL); 512 return (TCL_ERROR); 513 } 514 ret = dbp->get_re_pad(dbp, &intval); 515 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 516 "db get_re_pad")) == TCL_OK) 517 res = Tcl_NewIntObj((int)intval); 518 break; 519 case DBGETRESOURCE: 520 if (objc != 2) { 521 Tcl_WrongNumArgs(interp, 1, objv, NULL); 522 return (TCL_ERROR); 523 } 524 ret = dbp->get_re_source(dbp, &strval); 525 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 526 "db get_re_source")) == TCL_OK) 527 res = NewStringObj(strval, strlen(strval)); 528 break; 529 case DBTRUNCATE: 530 result = tcl_DbTruncate(interp, objc, objv, dbp); 531 break; 532 } 533 /* 534 * Only set result if we have a res. Otherwise, lower 535 * functions have already done so. 536 */ 537 if (result == TCL_OK && res) 538 Tcl_SetObjResult(interp, res); 539 return (result); 540} 541 542/* 543 * tcl_db_stat -- 544 */ 545static int 546tcl_DbStat(interp, objc, objv, dbp) 547 Tcl_Interp *interp; /* Interpreter */ 548 int objc; /* How many arguments? */ 549 Tcl_Obj *CONST objv[]; /* The argument objects */ 550 DB *dbp; /* Database pointer */ 551{ 552 static const char *dbstatopts[] = { 553#ifdef CONFIG_TEST 554 "-read_committed", 555 "-read_uncommitted", 556#endif 557 "-faststat", 558 "-txn", 559 NULL 560 }; 561 enum dbstatopts { 562#ifdef CONFIG_TEST 563 DBCUR_READ_COMMITTED, 564 DBCUR_READ_UNCOMMITTED, 565#endif 566 DBCUR_FASTSTAT, 567 DBCUR_TXN 568 }; 569 DBTYPE type; 570 DB_BTREE_STAT *bsp; 571 DB_HASH_STAT *hsp; 572 DB_QUEUE_STAT *qsp; 573 DB_TXN *txn; 574 Tcl_Obj *res, *flaglist, *myobjv[2]; 575 u_int32_t flag; 576 int i, optindex, result, ret; 577 char *arg, msg[MSG_SIZE]; 578 void *sp; 579 580 result = TCL_OK; 581 flag = 0; 582 txn = NULL; 583 sp = NULL; 584 i = 2; 585 while (i < objc) { 586 if (Tcl_GetIndexFromObj(interp, objv[i], dbstatopts, "option", 587 TCL_EXACT, &optindex) != TCL_OK) { 588 result = IS_HELP(objv[i]); 589 goto error; 590 } 591 i++; 592 switch ((enum dbstatopts)optindex) { 593#ifdef CONFIG_TEST 594 case DBCUR_READ_COMMITTED: 595 flag |= DB_READ_COMMITTED; 596 break; 597 case DBCUR_READ_UNCOMMITTED: 598 flag |= DB_READ_UNCOMMITTED; 599 break; 600#endif 601 case DBCUR_FASTSTAT: 602 flag |= DB_FAST_STAT; 603 break; 604 case DBCUR_TXN: 605 if (i == objc) { 606 Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?"); 607 result = TCL_ERROR; 608 break; 609 } 610 arg = Tcl_GetStringFromObj(objv[i++], NULL); 611 txn = NAME_TO_TXN(arg); 612 if (txn == NULL) { 613 snprintf(msg, MSG_SIZE, 614 "Stat: Invalid txn: %s\n", arg); 615 Tcl_SetResult(interp, msg, TCL_VOLATILE); 616 result = TCL_ERROR; 617 } 618 break; 619 } 620 if (result != TCL_OK) 621 break; 622 } 623 if (result != TCL_OK) 624 goto error; 625 626 _debug_check(); 627 ret = dbp->stat(dbp, txn, &sp, flag); 628 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db stat"); 629 if (result == TCL_ERROR) 630 return (result); 631 632 (void)dbp->get_type(dbp, &type); 633 /* 634 * Have our stats, now construct the name value 635 * list pairs and free up the memory. 636 */ 637 res = Tcl_NewObj(); 638 639 /* 640 * MAKE_STAT_LIST assumes 'res' and 'error' label. 641 */ 642 if (type == DB_HASH) { 643 hsp = (DB_HASH_STAT *)sp; 644 MAKE_STAT_LIST("Magic", hsp->hash_magic); 645 MAKE_STAT_LIST("Version", hsp->hash_version); 646 MAKE_STAT_LIST("Page size", hsp->hash_pagesize); 647 MAKE_STAT_LIST("Page count", hsp->hash_pagecnt); 648 MAKE_STAT_LIST("Number of keys", hsp->hash_nkeys); 649 MAKE_STAT_LIST("Number of records", hsp->hash_ndata); 650 MAKE_STAT_LIST("Fill factor", hsp->hash_ffactor); 651 MAKE_STAT_LIST("Buckets", hsp->hash_buckets); 652 if (flag != DB_FAST_STAT) { 653 MAKE_STAT_LIST("Free pages", hsp->hash_free); 654 MAKE_STAT_LIST("Bytes free", hsp->hash_bfree); 655 MAKE_STAT_LIST("Number of big pages", 656 hsp->hash_bigpages); 657 MAKE_STAT_LIST("Big pages bytes free", 658 hsp->hash_big_bfree); 659 MAKE_STAT_LIST("Overflow pages", hsp->hash_overflows); 660 MAKE_STAT_LIST("Overflow bytes free", 661 hsp->hash_ovfl_free); 662 MAKE_STAT_LIST("Duplicate pages", hsp->hash_dup); 663 MAKE_STAT_LIST("Duplicate pages bytes free", 664 hsp->hash_dup_free); 665 } 666 } else if (type == DB_QUEUE) { 667 qsp = (DB_QUEUE_STAT *)sp; 668 MAKE_STAT_LIST("Magic", qsp->qs_magic); 669 MAKE_STAT_LIST("Version", qsp->qs_version); 670 MAKE_STAT_LIST("Page size", qsp->qs_pagesize); 671 MAKE_STAT_LIST("Extent size", qsp->qs_extentsize); 672 MAKE_STAT_LIST("Number of records", qsp->qs_nkeys); 673 MAKE_STAT_LIST("Record length", qsp->qs_re_len); 674 MAKE_STAT_LIST("Record pad", qsp->qs_re_pad); 675 MAKE_STAT_LIST("First record number", qsp->qs_first_recno); 676 MAKE_STAT_LIST("Last record number", qsp->qs_cur_recno); 677 if (flag != DB_FAST_STAT) { 678 MAKE_STAT_LIST("Number of pages", qsp->qs_pages); 679 MAKE_STAT_LIST("Bytes free", qsp->qs_pgfree); 680 } 681 } else { /* BTREE and RECNO are same stats */ 682 bsp = (DB_BTREE_STAT *)sp; 683 MAKE_STAT_LIST("Magic", bsp->bt_magic); 684 MAKE_STAT_LIST("Version", bsp->bt_version); 685 MAKE_STAT_LIST("Number of keys", bsp->bt_nkeys); 686 MAKE_STAT_LIST("Number of records", bsp->bt_ndata); 687 MAKE_STAT_LIST("Minimum keys per page", bsp->bt_minkey); 688 MAKE_STAT_LIST("Fixed record length", bsp->bt_re_len); 689 MAKE_STAT_LIST("Record pad", bsp->bt_re_pad); 690 MAKE_STAT_LIST("Page size", bsp->bt_pagesize); 691 MAKE_STAT_LIST("Page count", bsp->bt_pagecnt); 692 if (flag != DB_FAST_STAT) { 693 MAKE_STAT_LIST("Levels", bsp->bt_levels); 694 MAKE_STAT_LIST("Internal pages", bsp->bt_int_pg); 695 MAKE_STAT_LIST("Leaf pages", bsp->bt_leaf_pg); 696 MAKE_STAT_LIST("Duplicate pages", bsp->bt_dup_pg); 697 MAKE_STAT_LIST("Overflow pages", bsp->bt_over_pg); 698 MAKE_STAT_LIST("Empty pages", bsp->bt_empty_pg); 699 MAKE_STAT_LIST("Pages on freelist", bsp->bt_free); 700 MAKE_STAT_LIST("Internal pages bytes free", 701 bsp->bt_int_pgfree); 702 MAKE_STAT_LIST("Leaf pages bytes free", 703 bsp->bt_leaf_pgfree); 704 MAKE_STAT_LIST("Duplicate pages bytes free", 705 bsp->bt_dup_pgfree); 706 MAKE_STAT_LIST("Bytes free in overflow pages", 707 bsp->bt_over_pgfree); 708 } 709 } 710 711 /* 712 * Construct a {name {flag1 flag2 ... flagN}} list for the 713 * dbp flags. These aren't access-method dependent, but they 714 * include all the interesting flags, and the integer value 715 * isn't useful from Tcl--return the strings instead. 716 */ 717 myobjv[0] = NewStringObj("Flags", strlen("Flags")); 718 myobjv[1] = _GetFlagsList(interp, dbp->flags, __db_get_flags_fn()); 719 flaglist = Tcl_NewListObj(2, myobjv); 720 if (flaglist == NULL) { 721 result = TCL_ERROR; 722 goto error; 723 } 724 if ((result = 725 Tcl_ListObjAppendElement(interp, res, flaglist)) != TCL_OK) 726 goto error; 727 728 Tcl_SetObjResult(interp, res); 729error: 730 if (sp != NULL) 731 __os_ufree(dbp->env, sp); 732 return (result); 733} 734 735/* 736 * tcl_db_close -- 737 */ 738static int 739tcl_DbClose(interp, objc, objv, dbp, dbip) 740 Tcl_Interp *interp; /* Interpreter */ 741 int objc; /* How many arguments? */ 742 Tcl_Obj *CONST objv[]; /* The argument objects */ 743 DB *dbp; /* Database pointer */ 744 DBTCL_INFO *dbip; /* Info pointer */ 745{ 746 static const char *dbclose[] = { 747 "-nosync", "--", NULL 748 }; 749 enum dbclose { 750 TCL_DBCLOSE_NOSYNC, 751 TCL_DBCLOSE_ENDARG 752 }; 753 u_int32_t flag; 754 int endarg, i, optindex, result, ret; 755 char *arg; 756 757 result = TCL_OK; 758 endarg = 0; 759 flag = 0; 760 if (objc > 4) { 761 Tcl_WrongNumArgs(interp, 2, objv, "?-nosync?"); 762 return (TCL_ERROR); 763 } 764 765 for (i = 2; i < objc; ++i) { 766 if (Tcl_GetIndexFromObj(interp, objv[i], dbclose, 767 "option", TCL_EXACT, &optindex) != TCL_OK) { 768 arg = Tcl_GetStringFromObj(objv[i], NULL); 769 if (arg[0] == '-') 770 return (IS_HELP(objv[i])); 771 else 772 Tcl_ResetResult(interp); 773 break; 774 } 775 switch ((enum dbclose)optindex) { 776 case TCL_DBCLOSE_NOSYNC: 777 flag = DB_NOSYNC; 778 break; 779 case TCL_DBCLOSE_ENDARG: 780 endarg = 1; 781 break; 782 } 783 /* 784 * If, at any time, parsing the args we get an error, 785 * bail out and return. 786 */ 787 if (result != TCL_OK) 788 return (result); 789 if (endarg) 790 break; 791 } 792 if (dbip->i_cdata != NULL) 793 __os_free(dbp->env, dbip->i_cdata); 794 _DbInfoDelete(interp, dbip); 795 _debug_check(); 796 797 /* Paranoia. */ 798 dbp->api_internal = NULL; 799 800 ret = (dbp)->close(dbp, flag); 801 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db close"); 802 return (result); 803} 804 805/* 806 * tcl_db_put -- 807 */ 808static int 809tcl_DbPut(interp, objc, objv, dbp) 810 Tcl_Interp *interp; /* Interpreter */ 811 int objc; /* How many arguments? */ 812 Tcl_Obj *CONST objv[]; /* The argument objects */ 813 DB *dbp; /* Database pointer */ 814{ 815 static const char *dbputopts[] = { 816#ifdef CONFIG_TEST 817 "-nodupdata", 818#endif 819 "-append", 820 "-nooverwrite", 821 "-partial", 822 "-txn", 823 NULL 824 }; 825 enum dbputopts { 826#ifdef CONFIG_TEST 827 DBGET_NODUPDATA, 828#endif 829 DBPUT_APPEND, 830 DBPUT_NOOVER, 831 DBPUT_PART, 832 DBPUT_TXN 833 }; 834 static const char *dbputapp[] = { 835 "-append", NULL 836 }; 837 enum dbputapp { DBPUT_APPEND0 }; 838 DBT key, data; 839 DBTYPE type; 840 DB_TXN *txn; 841 Tcl_Obj **elemv, *res; 842 void *dtmp, *ktmp; 843 db_recno_t recno; 844 u_int32_t flag; 845 int elemc, end, freekey, freedata; 846 int i, optindex, result, ret; 847 char *arg, msg[MSG_SIZE]; 848 849 txn = NULL; 850 result = TCL_OK; 851 flag = 0; 852 if (objc <= 3) { 853 Tcl_WrongNumArgs(interp, 2, objv, "?-args? key data"); 854 return (TCL_ERROR); 855 } 856 857 dtmp = ktmp = NULL; 858 freekey = freedata = 0; 859 memset(&key, 0, sizeof(key)); 860 memset(&data, 0, sizeof(data)); 861 862 /* 863 * If it is a QUEUE or RECNO database, the key is a record number 864 * and must be setup up to contain a db_recno_t. Otherwise the 865 * key is a "string". 866 */ 867 (void)dbp->get_type(dbp, &type); 868 869 /* 870 * We need to determine where the end of required args are. If we 871 * are using a QUEUE/RECNO db and -append, then there is just one 872 * req arg (data). Otherwise there are two (key data). 873 * 874 * We preparse the list to determine this since we need to know 875 * to properly check # of args for other options below. 876 */ 877 end = objc - 2; 878 if (type == DB_QUEUE || type == DB_RECNO) { 879 i = 2; 880 while (i < objc - 1) { 881 if (Tcl_GetIndexFromObj(interp, objv[i++], dbputapp, 882 "option", TCL_EXACT, &optindex) != TCL_OK) 883 continue; 884 switch ((enum dbputapp)optindex) { 885 case DBPUT_APPEND0: 886 end = objc - 1; 887 break; 888 } 889 } 890 } 891 Tcl_ResetResult(interp); 892 893 /* 894 * Get the command name index from the object based on the options 895 * defined above. 896 */ 897 i = 2; 898 while (i < end) { 899 if (Tcl_GetIndexFromObj(interp, objv[i], 900 dbputopts, "option", TCL_EXACT, &optindex) != TCL_OK) 901 return (IS_HELP(objv[i])); 902 i++; 903 switch ((enum dbputopts)optindex) { 904#ifdef CONFIG_TEST 905 case DBGET_NODUPDATA: 906 FLAG_CHECK(flag); 907 flag = DB_NODUPDATA; 908 break; 909#endif 910 case DBPUT_TXN: 911 if (i > (end - 1)) { 912 Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?"); 913 result = TCL_ERROR; 914 break; 915 } 916 arg = Tcl_GetStringFromObj(objv[i++], NULL); 917 txn = NAME_TO_TXN(arg); 918 if (txn == NULL) { 919 snprintf(msg, MSG_SIZE, 920 "Put: Invalid txn: %s\n", arg); 921 Tcl_SetResult(interp, msg, TCL_VOLATILE); 922 result = TCL_ERROR; 923 } 924 break; 925 case DBPUT_APPEND: 926 FLAG_CHECK(flag); 927 flag = DB_APPEND; 928 break; 929 case DBPUT_NOOVER: 930 FLAG_CHECK(flag); 931 flag = DB_NOOVERWRITE; 932 break; 933 case DBPUT_PART: 934 if (i > (end - 1)) { 935 Tcl_WrongNumArgs(interp, 2, objv, 936 "?-partial {offset length}?"); 937 result = TCL_ERROR; 938 break; 939 } 940 /* 941 * Get sublist as {offset length} 942 */ 943 result = Tcl_ListObjGetElements(interp, objv[i++], 944 &elemc, &elemv); 945 if (elemc != 2) { 946 Tcl_SetResult(interp, 947 "List must be {offset length}", TCL_STATIC); 948 result = TCL_ERROR; 949 break; 950 } 951 data.flags = DB_DBT_PARTIAL; 952 result = _GetUInt32(interp, elemv[0], &data.doff); 953 if (result != TCL_OK) 954 break; 955 result = _GetUInt32(interp, elemv[1], &data.dlen); 956 /* 957 * NOTE: We don't check result here because all we'd 958 * do is break anyway, and we are doing that. If you 959 * add code here, you WILL need to add the check 960 * for result. (See the check for save.doff, a few 961 * lines above and copy that.) 962 */ 963 break; 964 } 965 if (result != TCL_OK) 966 break; 967 } 968 969 if (result == TCL_ERROR) 970 return (result); 971 972 /* 973 * If we are a recno db and we are NOT using append, then the 2nd 974 * last arg is the key. 975 */ 976 if (type == DB_QUEUE || type == DB_RECNO) { 977 key.data = &recno; 978 key.ulen = key.size = sizeof(db_recno_t); 979 key.flags = DB_DBT_USERMEM; 980 if (flag == DB_APPEND) 981 recno = 0; 982 else { 983 result = _GetUInt32(interp, objv[objc-2], &recno); 984 if (result != TCL_OK) 985 return (result); 986 } 987 } else { 988 COMPQUIET(recno, 0); 989 990 ret = _CopyObjBytes(interp, objv[objc-2], &ktmp, 991 &key.size, &freekey); 992 if (ret != 0) { 993 result = _ReturnSetup(interp, ret, 994 DB_RETOK_DBPUT(ret), "db put"); 995 return (result); 996 } 997 key.data = ktmp; 998 } 999 ret = _CopyObjBytes(interp, objv[objc-1], &dtmp, &data.size, &freedata); 1000 if (ret != 0) { 1001 result = _ReturnSetup(interp, ret, 1002 DB_RETOK_DBPUT(ret), "db put"); 1003 goto out; 1004 } 1005 data.data = dtmp; 1006 _debug_check(); 1007 ret = dbp->put(dbp, txn, &key, &data, flag); 1008 result = _ReturnSetup(interp, ret, DB_RETOK_DBPUT(ret), "db put"); 1009 1010 /* We may have a returned record number. */ 1011 if (ret == 0 && 1012 (type == DB_QUEUE || type == DB_RECNO) && flag == DB_APPEND) { 1013 res = Tcl_NewWideIntObj((Tcl_WideInt)recno); 1014 Tcl_SetObjResult(interp, res); 1015 } 1016 1017out: if (dtmp != NULL && freedata) 1018 __os_free(dbp->env, dtmp); 1019 if (ktmp != NULL && freekey) 1020 __os_free(dbp->env, ktmp); 1021 return (result); 1022} 1023 1024/* 1025 * tcl_db_get -- 1026 */ 1027static int 1028tcl_DbGet(interp, objc, objv, dbp, ispget) 1029 Tcl_Interp *interp; /* Interpreter */ 1030 int objc; /* How many arguments? */ 1031 Tcl_Obj *CONST objv[]; /* The argument objects */ 1032 DB *dbp; /* Database pointer */ 1033 int ispget; /* 1 for pget, 0 for get */ 1034{ 1035 static const char *dbgetopts[] = { 1036#ifdef CONFIG_TEST 1037 "-data_buf_size", 1038 "-multi", 1039 "-nolease", 1040 "-read_committed", 1041 "-read_uncommitted", 1042#endif 1043 "-consume", 1044 "-consume_wait", 1045 "-get_both", 1046 "-glob", 1047 "-partial", 1048 "-recno", 1049 "-rmw", 1050 "-txn", 1051 "--", 1052 NULL 1053 }; 1054 enum dbgetopts { 1055#ifdef CONFIG_TEST 1056 DBGET_DATA_BUF_SIZE, 1057 DBGET_MULTI, 1058 DBGET_NOLEASE, 1059 DBGET_READ_COMMITTED, 1060 DBGET_READ_UNCOMMITTED, 1061#endif 1062 DBGET_CONSUME, 1063 DBGET_CONSUME_WAIT, 1064 DBGET_BOTH, 1065 DBGET_GLOB, 1066 DBGET_PART, 1067 DBGET_RECNO, 1068 DBGET_RMW, 1069 DBGET_TXN, 1070 DBGET_ENDARG 1071 }; 1072 DBC *dbc; 1073 DBT key, pkey, data, save; 1074 DBTYPE ptype, type; 1075 DB_TXN *txn; 1076 Tcl_Obj **elemv, *retlist; 1077 db_recno_t precno, recno; 1078 u_int32_t flag, cflag, isdup, mflag, rmw; 1079 int elemc, end, endarg, freekey, freedata, i; 1080 int optindex, result, ret, useglob, useprecno, userecno; 1081 char *arg, *pattern, *prefix, msg[MSG_SIZE]; 1082 void *dtmp, *ktmp; 1083#ifdef CONFIG_TEST 1084 int bufsize, data_buf_size; 1085#endif 1086 1087 result = TCL_OK; 1088 freekey = freedata = 0; 1089 cflag = endarg = flag = mflag = rmw = 0; 1090 useglob = userecno = 0; 1091 txn = NULL; 1092 pattern = prefix = NULL; 1093 dtmp = ktmp = NULL; 1094#ifdef CONFIG_TEST 1095 COMPQUIET(bufsize, 0); 1096 data_buf_size = 0; 1097#endif 1098 1099 if (objc < 3) { 1100 Tcl_WrongNumArgs(interp, 2, objv, "?-args? key"); 1101 return (TCL_ERROR); 1102 } 1103 1104 memset(&key, 0, sizeof(key)); 1105 memset(&data, 0, sizeof(data)); 1106 memset(&save, 0, sizeof(save)); 1107 1108 /* For the primary key in a pget call. */ 1109 memset(&pkey, 0, sizeof(pkey)); 1110 1111 /* 1112 * Get the command name index from the object based on the options 1113 * defined above. 1114 */ 1115 i = 2; 1116 (void)dbp->get_type(dbp, &type); 1117 end = objc; 1118 while (i < end) { 1119 if (Tcl_GetIndexFromObj(interp, objv[i], dbgetopts, "option", 1120 TCL_EXACT, &optindex) != TCL_OK) { 1121 arg = Tcl_GetStringFromObj(objv[i], NULL); 1122 if (arg[0] == '-') { 1123 result = IS_HELP(objv[i]); 1124 goto out; 1125 } else 1126 Tcl_ResetResult(interp); 1127 break; 1128 } 1129 i++; 1130 switch ((enum dbgetopts)optindex) { 1131#ifdef CONFIG_TEST 1132 case DBGET_DATA_BUF_SIZE: 1133 result = 1134 Tcl_GetIntFromObj(interp, objv[i], &data_buf_size); 1135 if (result != TCL_OK) 1136 goto out; 1137 i++; 1138 break; 1139 case DBGET_MULTI: 1140 mflag |= DB_MULTIPLE; 1141 result = 1142 Tcl_GetIntFromObj(interp, objv[i], &bufsize); 1143 if (result != TCL_OK) 1144 goto out; 1145 i++; 1146 break; 1147 case DBGET_NOLEASE: 1148 rmw |= DB_IGNORE_LEASE; 1149 break; 1150 case DBGET_READ_COMMITTED: 1151 rmw |= DB_READ_COMMITTED; 1152 break; 1153 case DBGET_READ_UNCOMMITTED: 1154 rmw |= DB_READ_UNCOMMITTED; 1155 break; 1156#endif 1157 case DBGET_BOTH: 1158 /* 1159 * Change 'end' and make sure we aren't already past 1160 * the new end. 1161 */ 1162 if (i > objc - 2) { 1163 Tcl_WrongNumArgs(interp, 2, objv, 1164 "?-get_both key data?"); 1165 result = TCL_ERROR; 1166 break; 1167 } 1168 end = objc - 2; 1169 FLAG_CHECK(flag); 1170 flag = DB_GET_BOTH; 1171 break; 1172 case DBGET_TXN: 1173 if (i >= end) { 1174 Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?"); 1175 result = TCL_ERROR; 1176 break; 1177 } 1178 arg = Tcl_GetStringFromObj(objv[i++], NULL); 1179 txn = NAME_TO_TXN(arg); 1180 if (txn == NULL) { 1181 snprintf(msg, MSG_SIZE, 1182 "Get: Invalid txn: %s\n", arg); 1183 Tcl_SetResult(interp, msg, TCL_VOLATILE); 1184 result = TCL_ERROR; 1185 } 1186 break; 1187 case DBGET_GLOB: 1188 useglob = 1; 1189 end = objc - 1; 1190 break; 1191 case DBGET_CONSUME: 1192 FLAG_CHECK(flag); 1193 flag = DB_CONSUME; 1194 break; 1195 case DBGET_CONSUME_WAIT: 1196 FLAG_CHECK(flag); 1197 flag = DB_CONSUME_WAIT; 1198 break; 1199 case DBGET_RECNO: 1200 end = objc - 1; 1201 userecno = 1; 1202 if (type != DB_RECNO && type != DB_QUEUE) { 1203 FLAG_CHECK(flag); 1204 flag = DB_SET_RECNO; 1205 key.flags |= DB_DBT_MALLOC; 1206 } 1207 break; 1208 case DBGET_RMW: 1209 rmw |= DB_RMW; 1210 break; 1211 case DBGET_PART: 1212 end = objc - 1; 1213 if (i == end) { 1214 Tcl_WrongNumArgs(interp, 2, objv, 1215 "?-partial {offset length}?"); 1216 result = TCL_ERROR; 1217 break; 1218 } 1219 /* 1220 * Get sublist as {offset length} 1221 */ 1222 result = Tcl_ListObjGetElements(interp, objv[i++], 1223 &elemc, &elemv); 1224 if (elemc != 2) { 1225 Tcl_SetResult(interp, 1226 "List must be {offset length}", TCL_STATIC); 1227 result = TCL_ERROR; 1228 break; 1229 } 1230 save.flags = DB_DBT_PARTIAL; 1231 result = _GetUInt32(interp, elemv[0], &save.doff); 1232 if (result != TCL_OK) 1233 break; 1234 result = _GetUInt32(interp, elemv[1], &save.dlen); 1235 /* 1236 * NOTE: We don't check result here because all we'd 1237 * do is break anyway, and we are doing that. If you 1238 * add code here, you WILL need to add the check 1239 * for result. (See the check for save.doff, a few 1240 * lines above and copy that.) 1241 */ 1242 break; 1243 case DBGET_ENDARG: 1244 endarg = 1; 1245 break; 1246 } 1247 if (result != TCL_OK) 1248 break; 1249 if (endarg) 1250 break; 1251 } 1252 if (result != TCL_OK) 1253 goto out; 1254 1255 if (type == DB_RECNO || type == DB_QUEUE) 1256 userecno = 1; 1257 1258 /* 1259 * Check args we have left versus the flags we were given. 1260 * We might have 0, 1 or 2 left. If we have 0, it must 1261 * be DB_CONSUME*, if 2, then DB_GET_BOTH, all others should 1262 * be 1. 1263 */ 1264 if (((flag == DB_CONSUME || flag == DB_CONSUME_WAIT) && i != objc) || 1265 (flag == DB_GET_BOTH && i != objc - 2)) { 1266 Tcl_SetResult(interp, 1267 "Wrong number of key/data given based on flags specified\n", 1268 TCL_STATIC); 1269 result = TCL_ERROR; 1270 goto out; 1271 } else if (flag == 0 && i != objc - 1) { 1272 Tcl_SetResult(interp, 1273 "Wrong number of key/data given\n", TCL_STATIC); 1274 result = TCL_ERROR; 1275 goto out; 1276 } 1277 1278 /* 1279 * Find out whether the primary key should also be a recno. 1280 */ 1281 if (ispget && dbp->s_primary != NULL) { 1282 (void)dbp->s_primary->get_type(dbp->s_primary, &ptype); 1283 useprecno = ptype == DB_RECNO || ptype == DB_QUEUE; 1284 } else 1285 useprecno = 0; 1286 1287 /* 1288 * Check for illegal combos of options. 1289 */ 1290 if (useglob && (userecno || flag == DB_SET_RECNO || 1291 type == DB_RECNO || type == DB_QUEUE)) { 1292 Tcl_SetResult(interp, 1293 "Cannot use -glob and record numbers.\n", 1294 TCL_STATIC); 1295 result = TCL_ERROR; 1296 goto out; 1297 } 1298#ifdef CONFIG_TEST 1299 if (data_buf_size != 0 && flag == DB_GET_BOTH) { 1300 Tcl_SetResult(interp, 1301 "Only one of -data_buf_size or -get_both can be specified.\n", 1302 TCL_STATIC); 1303 result = TCL_ERROR; 1304 goto out; 1305 } 1306 if (data_buf_size != 0 && mflag != 0) { 1307 Tcl_SetResult(interp, 1308 "Only one of -data_buf_size or -multi can be specified.\n", 1309 TCL_STATIC); 1310 result = TCL_ERROR; 1311 goto out; 1312 } 1313#endif 1314 if (useglob && flag == DB_GET_BOTH) { 1315 Tcl_SetResult(interp, 1316 "Only one of -glob or -get_both can be specified.\n", 1317 TCL_STATIC); 1318 result = TCL_ERROR; 1319 goto out; 1320 } 1321 1322 if (useglob) 1323 pattern = Tcl_GetStringFromObj(objv[objc - 1], NULL); 1324 1325 /* 1326 * This is the list we return 1327 */ 1328 retlist = Tcl_NewListObj(0, NULL); 1329 save.flags |= DB_DBT_MALLOC; 1330 1331 /* 1332 * isdup is used to know if we support duplicates. If not, we 1333 * can just do a db->get call and avoid using cursors. 1334 */ 1335 if ((ret = dbp->get_flags(dbp, &isdup)) != 0) { 1336 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db get"); 1337 goto out; 1338 } 1339 isdup &= DB_DUP; 1340 1341 /* 1342 * If the database doesn't support duplicates or we're performing 1343 * ops that don't require returning multiple items, use DB->get 1344 * instead of a cursor operation. 1345 */ 1346 if (pattern == NULL && (isdup == 0 || mflag != 0 || 1347#ifdef CONFIG_TEST 1348 data_buf_size != 0 || 1349#endif 1350 flag == DB_SET_RECNO || flag == DB_GET_BOTH || 1351 flag == DB_CONSUME || flag == DB_CONSUME_WAIT)) { 1352#ifdef CONFIG_TEST 1353 if (data_buf_size == 0) { 1354 F_CLR(&save, DB_DBT_USERMEM); 1355 F_SET(&save, DB_DBT_MALLOC); 1356 } else { 1357 (void)__os_malloc( 1358 NULL, (size_t)data_buf_size, &save.data); 1359 save.ulen = (u_int32_t)data_buf_size; 1360 F_CLR(&save, DB_DBT_MALLOC); 1361 F_SET(&save, DB_DBT_USERMEM); 1362 } 1363#endif 1364 if (flag == DB_GET_BOTH) { 1365 if (userecno) { 1366 result = _GetUInt32(interp, 1367 objv[(objc - 2)], &recno); 1368 if (result == TCL_OK) { 1369 key.data = &recno; 1370 key.size = sizeof(db_recno_t); 1371 } else 1372 goto out; 1373 } else { 1374 /* 1375 * Some get calls (SET_*) can change the 1376 * key pointers. So, we need to store 1377 * the allocated key space in a tmp. 1378 */ 1379 ret = _CopyObjBytes(interp, objv[objc-2], 1380 &key.data, &key.size, &freekey); 1381 if (ret != 0) { 1382 result = _ReturnSetup(interp, ret, 1383 DB_RETOK_DBGET(ret), "db get"); 1384 goto out; 1385 } 1386 } 1387 ktmp = key.data; 1388 /* 1389 * Already checked args above. Fill in key and save. 1390 * Save is used in the dbp->get call below to fill in 1391 * data. 1392 * 1393 * If the "data" here is really a primary key--that 1394 * is, if we're in a pget--and that primary key 1395 * is a recno, treat it appropriately as an int. 1396 */ 1397 if (useprecno) { 1398 result = _GetUInt32(interp, 1399 objv[objc - 1], &precno); 1400 if (result == TCL_OK) { 1401 save.data = &precno; 1402 save.size = sizeof(db_recno_t); 1403 } else 1404 goto out; 1405 } else { 1406 ret = _CopyObjBytes(interp, objv[objc-1], 1407 &dtmp, &save.size, &freedata); 1408 if (ret != 0) { 1409 result = _ReturnSetup(interp, ret, 1410 DB_RETOK_DBGET(ret), "db get"); 1411 goto out; 1412 } 1413 save.data = dtmp; 1414 } 1415 } else if (flag != DB_CONSUME && flag != DB_CONSUME_WAIT) { 1416 if (userecno) { 1417 result = _GetUInt32( 1418 interp, objv[(objc - 1)], &recno); 1419 if (result == TCL_OK) { 1420 key.data = &recno; 1421 key.size = sizeof(db_recno_t); 1422 } else 1423 goto out; 1424 } else { 1425 /* 1426 * Some get calls (SET_*) can change the 1427 * key pointers. So, we need to store 1428 * the allocated key space in a tmp. 1429 */ 1430 ret = _CopyObjBytes(interp, objv[objc-1], 1431 &key.data, &key.size, &freekey); 1432 if (ret != 0) { 1433 result = _ReturnSetup(interp, ret, 1434 DB_RETOK_DBGET(ret), "db get"); 1435 goto out; 1436 } 1437 } 1438 ktmp = key.data; 1439#ifdef CONFIG_TEST 1440 if (mflag & DB_MULTIPLE) { 1441 if ((ret = __os_malloc(dbp->env, 1442 (size_t)bufsize, &save.data)) != 0) { 1443 Tcl_SetResult(interp, 1444 db_strerror(ret), TCL_STATIC); 1445 goto out; 1446 } 1447 save.ulen = (u_int32_t)bufsize; 1448 F_CLR(&save, DB_DBT_MALLOC); 1449 F_SET(&save, DB_DBT_USERMEM); 1450 } 1451#endif 1452 } 1453 1454 data = save; 1455 1456 if (ispget) { 1457 if (flag == DB_GET_BOTH) { 1458 pkey.data = save.data; 1459 pkey.size = save.size; 1460 data.data = NULL; 1461 data.size = 0; 1462 } 1463 F_SET(&pkey, DB_DBT_MALLOC); 1464 _debug_check(); 1465 ret = dbp->pget(dbp, 1466 txn, &key, &pkey, &data, flag | rmw); 1467 } else { 1468 _debug_check(); 1469 ret = dbp->get(dbp, 1470 txn, &key, &data, flag | rmw | mflag); 1471 } 1472 result = _ReturnSetup(interp, ret, DB_RETOK_DBGET(ret), 1473 "db get"); 1474 if (ret == 0) { 1475 /* 1476 * Success. Return a list of the form {name value} 1477 * If it was a recno in key.data, we need to convert 1478 * into a string/object representation of that recno. 1479 */ 1480 if (mflag & DB_MULTIPLE) 1481 result = _SetMultiList(interp, 1482 retlist, &key, &data, type, flag); 1483 else if (type == DB_RECNO || type == DB_QUEUE) 1484 if (ispget) 1485 result = _Set3DBTList(interp, 1486 retlist, &key, 1, &pkey, 1487 useprecno, &data); 1488 else 1489 result = _SetListRecnoElem(interp, 1490 retlist, *(db_recno_t *)key.data, 1491 data.data, data.size); 1492 else { 1493 if (ispget) 1494 result = _Set3DBTList(interp, 1495 retlist, &key, 0, &pkey, 1496 useprecno, &data); 1497 else 1498 result = _SetListElem(interp, retlist, 1499 key.data, key.size, 1500 data.data, data.size); 1501 } 1502 } 1503 /* 1504 * Free space from DBT. 1505 * 1506 * If we set DB_DBT_MALLOC, we need to free the space if and 1507 * only if we succeeded and if DB allocated anything (the 1508 * pointer has changed from what we passed in). If 1509 * DB_DBT_MALLOC is not set, this is a bulk get buffer, and 1510 * needs to be freed no matter what. 1511 */ 1512 if (F_ISSET(&key, DB_DBT_MALLOC) && ret == 0 && 1513 key.data != ktmp) 1514 __os_ufree(dbp->env, key.data); 1515 if (F_ISSET(&data, DB_DBT_MALLOC) && ret == 0 && 1516 data.data != dtmp) 1517 __os_ufree(dbp->env, data.data); 1518 else if (!F_ISSET(&data, DB_DBT_MALLOC)) 1519 __os_free(dbp->env, data.data); 1520 if (ispget && ret == 0 && pkey.data != save.data) 1521 __os_ufree(dbp->env, pkey.data); 1522 if (result == TCL_OK) 1523 Tcl_SetObjResult(interp, retlist); 1524 goto out; 1525 } 1526 1527 if (userecno) { 1528 result = _GetUInt32(interp, objv[(objc - 1)], &recno); 1529 if (result == TCL_OK) { 1530 key.data = &recno; 1531 key.size = sizeof(db_recno_t); 1532 } else 1533 goto out; 1534 } else { 1535 /* 1536 * Some get calls (SET_*) can change the 1537 * key pointers. So, we need to store 1538 * the allocated key space in a tmp. 1539 */ 1540 ret = _CopyObjBytes(interp, objv[objc-1], &key.data, 1541 &key.size, &freekey); 1542 if (ret != 0) { 1543 result = _ReturnSetup(interp, ret, 1544 DB_RETOK_DBGET(ret), "db get"); 1545 return (result); 1546 } 1547 } 1548 ktmp = key.data; 1549 ret = dbp->cursor(dbp, txn, &dbc, 0); 1550 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db cursor"); 1551 if (result == TCL_ERROR) 1552 goto out; 1553 1554 /* 1555 * At this point, we have a cursor, if we have a pattern, 1556 * we go to the nearest one and step forward until we don't 1557 * have any more that match the pattern prefix. If we have 1558 * an exact key, we go to that key position, and step through 1559 * all the duplicates. In either case we build up a list of 1560 * the form {{key data} {key data}...} along the way. 1561 */ 1562 memset(&data, 0, sizeof(data)); 1563 /* 1564 * Restore any "partial" info we have saved. 1565 */ 1566 data = save; 1567 if (pattern) { 1568 /* 1569 * Note, prefix is returned in new space. Must free it. 1570 */ 1571 ret = _GetGlobPrefix(pattern, &prefix); 1572 if (ret) { 1573 result = TCL_ERROR; 1574 Tcl_SetResult(interp, 1575 "Unable to allocate pattern space", TCL_STATIC); 1576 goto out1; 1577 } 1578 key.data = prefix; 1579 key.size = strlen(prefix); 1580 /* 1581 * If they give us an empty pattern string 1582 * (i.e. -glob *), go through entire DB. 1583 */ 1584 if (strlen(prefix) == 0) 1585 cflag = DB_FIRST; 1586 else 1587 cflag = DB_SET_RANGE; 1588 } else 1589 cflag = DB_SET; 1590 if (ispget) { 1591 _debug_check(); 1592 F_SET(&pkey, DB_DBT_MALLOC); 1593 ret = dbc->pget(dbc, &key, &pkey, &data, cflag | rmw); 1594 } else { 1595 _debug_check(); 1596 ret = dbc->get(dbc, &key, &data, cflag | rmw); 1597 } 1598 result = _ReturnSetup(interp, ret, DB_RETOK_DBCGET(ret), 1599 "db get (cursor)"); 1600 if (result == TCL_ERROR) 1601 goto out1; 1602 if (pattern) { 1603 if (ret == 0 && prefix != NULL && 1604 memcmp(key.data, prefix, strlen(prefix)) != 0) { 1605 /* 1606 * Free space from DB_DBT_MALLOC 1607 */ 1608 __os_ufree(dbp->env, data.data); 1609 goto out1; 1610 } 1611 cflag = DB_NEXT; 1612 } else 1613 cflag = DB_NEXT_DUP; 1614 1615 while (ret == 0 && result == TCL_OK) { 1616 /* 1617 * Build up our {name value} sublist 1618 */ 1619 if (ispget) 1620 result = _Set3DBTList(interp, retlist, &key, 0, 1621 &pkey, useprecno, &data); 1622 else 1623 result = _SetListElem(interp, retlist, 1624 key.data, key.size, data.data, data.size); 1625 /* 1626 * Free space from DB_DBT_MALLOC 1627 */ 1628 if (ispget) 1629 __os_ufree(dbp->env, pkey.data); 1630 __os_ufree(dbp->env, data.data); 1631 if (result != TCL_OK) 1632 break; 1633 /* 1634 * Append {name value} to return list 1635 */ 1636 memset(&key, 0, sizeof(key)); 1637 memset(&pkey, 0, sizeof(pkey)); 1638 memset(&data, 0, sizeof(data)); 1639 /* 1640 * Restore any "partial" info we have saved. 1641 */ 1642 data = save; 1643 if (ispget) { 1644 F_SET(&pkey, DB_DBT_MALLOC); 1645 ret = dbc->pget(dbc, &key, &pkey, &data, cflag | rmw); 1646 } else 1647 ret = dbc->get(dbc, &key, &data, cflag | rmw); 1648 if (ret == 0 && prefix != NULL && 1649 memcmp(key.data, prefix, strlen(prefix)) != 0) { 1650 /* 1651 * Free space from DB_DBT_MALLOC 1652 */ 1653 __os_ufree(dbp->env, data.data); 1654 break; 1655 } 1656 } 1657out1: 1658 (void)dbc->close(dbc); 1659 if (result == TCL_OK) 1660 Tcl_SetObjResult(interp, retlist); 1661out: 1662 /* 1663 * _GetGlobPrefix(), the function which allocates prefix, works 1664 * by copying and condensing another string. Thus prefix may 1665 * have multiple nuls at the end, so we free using __os_free(). 1666 */ 1667 if (prefix != NULL) 1668 __os_free(dbp->env, prefix); 1669 if (dtmp != NULL && freedata) 1670 __os_free(dbp->env, dtmp); 1671 if (ktmp != NULL && freekey) 1672 __os_free(dbp->env, ktmp); 1673 return (result); 1674} 1675 1676/* 1677 * tcl_db_delete -- 1678 */ 1679static int 1680tcl_DbDelete(interp, objc, objv, dbp) 1681 Tcl_Interp *interp; /* Interpreter */ 1682 int objc; /* How many arguments? */ 1683 Tcl_Obj *CONST objv[]; /* The argument objects */ 1684 DB *dbp; /* Database pointer */ 1685{ 1686 static const char *dbdelopts[] = { 1687 "-glob", 1688 "-txn", 1689 NULL 1690 }; 1691 enum dbdelopts { 1692 DBDEL_GLOB, 1693 DBDEL_TXN 1694 }; 1695 DBC *dbc; 1696 DBT key, data; 1697 DBTYPE type; 1698 DB_TXN *txn; 1699 void *ktmp; 1700 db_recno_t recno; 1701 int freekey, i, optindex, result, ret; 1702 u_int32_t flag; 1703 char *arg, *pattern, *prefix, msg[MSG_SIZE]; 1704 1705 result = TCL_OK; 1706 freekey = 0; 1707 pattern = prefix = NULL; 1708 txn = NULL; 1709 if (objc < 3) { 1710 Tcl_WrongNumArgs(interp, 2, objv, "?-args? key"); 1711 return (TCL_ERROR); 1712 } 1713 1714 ktmp = NULL; 1715 memset(&key, 0, sizeof(key)); 1716 /* 1717 * The first arg must be -glob, -txn or a list of keys. 1718 */ 1719 i = 2; 1720 while (i < objc) { 1721 if (Tcl_GetIndexFromObj(interp, objv[i], dbdelopts, "option", 1722 TCL_EXACT, &optindex) != TCL_OK) { 1723 /* 1724 * If we don't have a -glob or -txn, then the remaining 1725 * args must be exact keys. Reset the result so we 1726 * don't get an errant error message if there is another 1727 * error. 1728 */ 1729 if (IS_HELP(objv[i]) == TCL_OK) 1730 return (TCL_OK); 1731 Tcl_ResetResult(interp); 1732 break; 1733 } 1734 i++; 1735 switch ((enum dbdelopts)optindex) { 1736 case DBDEL_TXN: 1737 if (i == objc) { 1738 /* 1739 * Someone could conceivably have a key of 1740 * the same name. So just break and use it. 1741 */ 1742 i--; 1743 break; 1744 } 1745 arg = Tcl_GetStringFromObj(objv[i++], NULL); 1746 txn = NAME_TO_TXN(arg); 1747 if (txn == NULL) { 1748 snprintf(msg, MSG_SIZE, 1749 "Delete: Invalid txn: %s\n", arg); 1750 Tcl_SetResult(interp, msg, TCL_VOLATILE); 1751 result = TCL_ERROR; 1752 } 1753 break; 1754 case DBDEL_GLOB: 1755 /* 1756 * Get the pattern. Get the prefix and use cursors to 1757 * get all the data items. 1758 */ 1759 if (i == objc) { 1760 /* 1761 * Someone could conceivably have a key of 1762 * the same name. So just break and use it. 1763 */ 1764 i--; 1765 break; 1766 } 1767 pattern = Tcl_GetStringFromObj(objv[i++], NULL); 1768 break; 1769 } 1770 if (result != TCL_OK) 1771 break; 1772 } 1773 1774 if (result != TCL_OK) 1775 goto out; 1776 /* 1777 * XXX 1778 * For consistency with get, we have decided for the moment, to 1779 * allow -glob, or one key, not many. The code was originally 1780 * written to take many keys and we'll leave it that way, because 1781 * tcl_DbGet may one day accept many disjoint keys to get, rather 1782 * than one, and at that time we'd make delete be consistent. In 1783 * any case, the code is already here and there is no need to remove, 1784 * just check that we only have one arg left. 1785 * 1786 * If we have a pattern AND more keys to process, there is an error. 1787 * Either we have some number of exact keys, or we have a pattern. 1788 */ 1789 if (pattern == NULL) { 1790 if (i != (objc - 1)) { 1791 Tcl_WrongNumArgs( 1792 interp, 2, objv, "?args? -glob pattern | key"); 1793 result = TCL_ERROR; 1794 goto out; 1795 } 1796 } else { 1797 if (i != objc) { 1798 Tcl_WrongNumArgs( 1799 interp, 2, objv, "?args? -glob pattern | key"); 1800 result = TCL_ERROR; 1801 goto out; 1802 } 1803 } 1804 1805 /* 1806 * If we have remaining args, they are all exact keys. Call 1807 * DB->del on each of those keys. 1808 * 1809 * If it is a RECNO database, the key is a record number and must be 1810 * setup up to contain a db_recno_t. Otherwise the key is a "string". 1811 */ 1812 (void)dbp->get_type(dbp, &type); 1813 ret = 0; 1814 while (i < objc && ret == 0) { 1815 memset(&key, 0, sizeof(key)); 1816 if (type == DB_RECNO || type == DB_QUEUE) { 1817 result = _GetUInt32(interp, objv[i++], &recno); 1818 if (result == TCL_OK) { 1819 key.data = &recno; 1820 key.size = sizeof(db_recno_t); 1821 } else 1822 return (result); 1823 } else { 1824 ret = _CopyObjBytes(interp, objv[i++], &ktmp, 1825 &key.size, &freekey); 1826 if (ret != 0) { 1827 result = _ReturnSetup(interp, ret, 1828 DB_RETOK_DBDEL(ret), "db del"); 1829 return (result); 1830 } 1831 key.data = ktmp; 1832 } 1833 _debug_check(); 1834 ret = dbp->del(dbp, txn, &key, 0); 1835 /* 1836 * If we have any error, set up return result and stop 1837 * processing keys. 1838 */ 1839 if (ktmp != NULL && freekey) 1840 __os_free(dbp->env, ktmp); 1841 if (ret != 0) 1842 break; 1843 } 1844 result = _ReturnSetup(interp, ret, DB_RETOK_DBDEL(ret), "db del"); 1845 1846 /* 1847 * At this point we've either finished or, if we have a pattern, 1848 * we go to the nearest one and step forward until we don't 1849 * have any more that match the pattern prefix. 1850 */ 1851 if (pattern) { 1852 ret = dbp->cursor(dbp, txn, &dbc, 0); 1853 if (ret != 0) { 1854 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 1855 "db cursor"); 1856 goto out; 1857 } 1858 /* 1859 * Note, prefix is returned in new space. Must free it. 1860 */ 1861 memset(&key, 0, sizeof(key)); 1862 memset(&data, 0, sizeof(data)); 1863 ret = _GetGlobPrefix(pattern, &prefix); 1864 if (ret) { 1865 result = TCL_ERROR; 1866 Tcl_SetResult(interp, 1867 "Unable to allocate pattern space", TCL_STATIC); 1868 goto out; 1869 } 1870 key.data = prefix; 1871 key.size = strlen(prefix); 1872 if (strlen(prefix) == 0) 1873 flag = DB_FIRST; 1874 else 1875 flag = DB_SET_RANGE; 1876 ret = dbc->get(dbc, &key, &data, flag); 1877 while (ret == 0 && 1878 memcmp(key.data, prefix, strlen(prefix)) == 0) { 1879 /* 1880 * Each time through here the cursor is pointing 1881 * at the current valid item. Delete it and 1882 * move ahead. 1883 */ 1884 _debug_check(); 1885 ret = dbc->del(dbc, 0); 1886 if (ret != 0) { 1887 result = _ReturnSetup(interp, ret, 1888 DB_RETOK_DBCDEL(ret), "db c_del"); 1889 break; 1890 } 1891 /* 1892 * Deleted the current, now move to the next item 1893 * in the list, check if it matches the prefix pattern. 1894 */ 1895 memset(&key, 0, sizeof(key)); 1896 memset(&data, 0, sizeof(data)); 1897 ret = dbc->get(dbc, &key, &data, DB_NEXT); 1898 } 1899 if (ret == DB_NOTFOUND) 1900 ret = 0; 1901 /* 1902 * _GetGlobPrefix(), the function which allocates prefix, works 1903 * by copying and condensing another string. Thus prefix may 1904 * have multiple nuls at the end, so we free using __os_free(). 1905 */ 1906 __os_free(dbp->env, prefix); 1907 (void)dbc->close(dbc); 1908 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db del"); 1909 } 1910out: 1911 return (result); 1912} 1913 1914/* 1915 * tcl_db_cursor -- 1916 */ 1917static int 1918tcl_DbCursor(interp, objc, objv, dbp, dbcp) 1919 Tcl_Interp *interp; /* Interpreter */ 1920 int objc; /* How many arguments? */ 1921 Tcl_Obj *CONST objv[]; /* The argument objects */ 1922 DB *dbp; /* Database pointer */ 1923 DBC **dbcp; /* Return cursor pointer */ 1924{ 1925 static const char *dbcuropts[] = { 1926#ifdef CONFIG_TEST 1927 "-read_committed", 1928 "-read_uncommitted", 1929 "-update", 1930#endif 1931 "-txn", 1932 NULL 1933 }; 1934 enum dbcuropts { 1935#ifdef CONFIG_TEST 1936 DBCUR_READ_COMMITTED, 1937 DBCUR_READ_UNCOMMITTED, 1938 DBCUR_UPDATE, 1939#endif 1940 DBCUR_TXN 1941 }; 1942 DB_TXN *txn; 1943 u_int32_t flag; 1944 int i, optindex, result, ret; 1945 char *arg, msg[MSG_SIZE]; 1946 1947 result = TCL_OK; 1948 flag = 0; 1949 txn = NULL; 1950 i = 2; 1951 while (i < objc) { 1952 if (Tcl_GetIndexFromObj(interp, objv[i], dbcuropts, "option", 1953 TCL_EXACT, &optindex) != TCL_OK) { 1954 result = IS_HELP(objv[i]); 1955 goto out; 1956 } 1957 i++; 1958 switch ((enum dbcuropts)optindex) { 1959#ifdef CONFIG_TEST 1960 case DBCUR_READ_COMMITTED: 1961 flag |= DB_READ_COMMITTED; 1962 break; 1963 case DBCUR_READ_UNCOMMITTED: 1964 flag |= DB_READ_UNCOMMITTED; 1965 break; 1966 case DBCUR_UPDATE: 1967 flag |= DB_WRITECURSOR; 1968 break; 1969#endif 1970 case DBCUR_TXN: 1971 if (i == objc) { 1972 Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?"); 1973 result = TCL_ERROR; 1974 break; 1975 } 1976 arg = Tcl_GetStringFromObj(objv[i++], NULL); 1977 txn = NAME_TO_TXN(arg); 1978 if (txn == NULL) { 1979 snprintf(msg, MSG_SIZE, 1980 "Cursor: Invalid txn: %s\n", arg); 1981 Tcl_SetResult(interp, msg, TCL_VOLATILE); 1982 result = TCL_ERROR; 1983 } 1984 break; 1985 } 1986 if (result != TCL_OK) 1987 break; 1988 } 1989 if (result != TCL_OK) 1990 goto out; 1991 1992 _debug_check(); 1993 ret = dbp->cursor(dbp, txn, dbcp, flag); 1994 if (ret != 0) 1995 result = _ErrorSetup(interp, ret, "db cursor"); 1996out: 1997 return (result); 1998} 1999 2000/* 2001 * tcl_DbAssociate -- 2002 * Call DB->associate(). 2003 */ 2004static int 2005tcl_DbAssociate(interp, objc, objv, dbp) 2006 Tcl_Interp *interp; 2007 int objc; 2008 Tcl_Obj *CONST objv[]; 2009 DB *dbp; 2010{ 2011 static const char *dbaopts[] = { 2012 "-create", 2013 "-immutable_key", 2014 "-txn", 2015 NULL 2016 }; 2017 enum dbaopts { 2018 DBA_CREATE, 2019 DBA_IMMUTABLE_KEY, 2020 DBA_TXN 2021 }; 2022 DB *sdbp; 2023 DB_TXN *txn; 2024 DBTCL_INFO *sdbip; 2025 int i, optindex, result, ret; 2026 char *arg, msg[MSG_SIZE]; 2027 u_int32_t flag; 2028#ifdef CONFIG_TEST 2029 /* 2030 * When calling DB->associate over RPC, the Tcl API uses 2031 * special flags that the RPC server interprets to set the 2032 * callback correctly. 2033 */ 2034 const char *cbname; 2035 struct { 2036 const char *name; 2037 u_int32_t flag; 2038 } *cb, callbacks[] = { 2039 { "", 0 }, /* A NULL callback in Tcl. */ 2040 { "_s_reversedata", DB_RPC2ND_REVERSEDATA }, 2041 { "_s_noop", DB_RPC2ND_NOOP }, 2042 { "_s_concatkeydata", DB_RPC2ND_CONCATKEYDATA }, 2043 { "_s_concatdatakey", DB_RPC2ND_CONCATDATAKEY }, 2044 { "_s_reverseconcat", DB_RPC2ND_REVERSECONCAT }, 2045 { "_s_truncdata", DB_RPC2ND_TRUNCDATA }, 2046 { "_s_reversedata", DB_RPC2ND_REVERSEDATA }, 2047 { "_s_constant", DB_RPC2ND_CONSTANT }, 2048 { "sj_getzip", DB_RPC2ND_GETZIP }, 2049 { "sj_getname", DB_RPC2ND_GETNAME }, 2050 { NULL, 0 } 2051 }; 2052#endif 2053 2054 txn = NULL; 2055 result = TCL_OK; 2056 flag = 0; 2057 if (objc < 2) { 2058 Tcl_WrongNumArgs(interp, 2, objv, "[callback] secondary"); 2059 return (TCL_ERROR); 2060 } 2061 2062 i = 2; 2063 while (i < objc) { 2064 if (Tcl_GetIndexFromObj(interp, objv[i], dbaopts, "option", 2065 TCL_EXACT, &optindex) != TCL_OK) { 2066 result = IS_HELP(objv[i]); 2067 if (result == TCL_OK) 2068 return (result); 2069 result = TCL_OK; 2070 Tcl_ResetResult(interp); 2071 break; 2072 } 2073 i++; 2074 switch ((enum dbaopts)optindex) { 2075 case DBA_CREATE: 2076 flag |= DB_CREATE; 2077 break; 2078 case DBA_IMMUTABLE_KEY: 2079 flag |= DB_IMMUTABLE_KEY; 2080 break; 2081 case DBA_TXN: 2082 if (i > (objc - 1)) { 2083 Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?"); 2084 result = TCL_ERROR; 2085 break; 2086 } 2087 arg = Tcl_GetStringFromObj(objv[i++], NULL); 2088 txn = NAME_TO_TXN(arg); 2089 if (txn == NULL) { 2090 snprintf(msg, MSG_SIZE, 2091 "Associate: Invalid txn: %s\n", arg); 2092 Tcl_SetResult(interp, msg, TCL_VOLATILE); 2093 result = TCL_ERROR; 2094 } 2095 break; 2096 } 2097 } 2098 if (result != TCL_OK) 2099 return (result); 2100 2101 /* 2102 * Better be 1 or 2 args left. The last arg must be the sdb 2103 * handle. If 2 args then objc-2 is the callback proc, else 2104 * we have a NULL callback. 2105 */ 2106 /* Get the secondary DB handle. */ 2107 arg = Tcl_GetStringFromObj(objv[objc - 1], NULL); 2108 sdbp = NAME_TO_DB(arg); 2109 if (sdbp == NULL) { 2110 snprintf(msg, MSG_SIZE, 2111 "Associate: Invalid database handle: %s\n", arg); 2112 Tcl_SetResult(interp, msg, TCL_VOLATILE); 2113 return (TCL_ERROR); 2114 } 2115 2116 /* 2117 * The callback is simply a Tcl object containing the name 2118 * of the callback proc, which is the second-to-last argument. 2119 * 2120 * Note that the callback needs to go in the *secondary* DB handle's 2121 * info struct; we may have multiple secondaries with different 2122 * callbacks. 2123 */ 2124 sdbip = (DBTCL_INFO *)sdbp->api_internal; 2125 2126#ifdef CONFIG_TEST 2127 if (i != objc - 1 && RPC_ON(dbp->dbenv)) { 2128 /* 2129 * The flag values allowed to DB->associate may have changed to 2130 * overlap with the range we've chosen. If this happens, we 2131 * need to reset all of the RPC_2ND_* flags to a new range. 2132 */ 2133 if ((flag & DB_RPC2ND_MASK) != 0) { 2134 snprintf(msg, MSG_SIZE, 2135 "RPC secondary flags overlap -- recalculate!\n"); 2136 Tcl_SetResult(interp, msg, TCL_VOLATILE); 2137 return (TCL_ERROR); 2138 } 2139 2140 cbname = Tcl_GetStringFromObj(objv[objc - 2], NULL); 2141 for (cb = callbacks; cb->name != NULL; cb++) 2142 if (strcmp(cb->name, cbname) == 0) { 2143 flag |= cb->flag; 2144 break; 2145 } 2146 2147 if (cb->name == NULL) { 2148 snprintf(msg, MSG_SIZE, 2149 "Associate: unknown callback: %s\n", cbname); 2150 Tcl_SetResult(interp, msg, TCL_VOLATILE); 2151 return (TCL_ERROR); 2152 } 2153 2154 ret = dbp->associate(dbp, txn, sdbp, NULL, flag); 2155 2156 /* 2157 * The primary reference isn't set when calling through 2158 * the RPC server, but the Tcl API peeks at it in other 2159 * places (see tcl_DbGet). 2160 */ 2161 if (ret == 0) 2162 sdbp->s_primary = dbp; 2163 } else if (i != objc - 1) { 2164#else 2165 if (i != objc - 1) { 2166#endif 2167 /* 2168 * We have 2 args, get the callback. 2169 */ 2170 sdbip->i_second_call = objv[objc - 2]; 2171 Tcl_IncrRefCount(sdbip->i_second_call); 2172 2173 /* Now call associate. */ 2174 _debug_check(); 2175 ret = dbp->associate(dbp, txn, sdbp, tcl_second_call, flag); 2176 } else { 2177 /* 2178 * We have a NULL callback. 2179 */ 2180 sdbip->i_second_call = NULL; 2181 ret = dbp->associate(dbp, txn, sdbp, NULL, flag); 2182 } 2183 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "associate"); 2184 2185 return (result); 2186} 2187 2188/* 2189 * tcl_second_call -- 2190 * Callback function for secondary indices. Get the callback 2191 * out of ip->i_second_call and call it. 2192 */ 2193static int 2194tcl_second_call(dbp, pkey, data, skey) 2195 DB *dbp; 2196 const DBT *pkey, *data; 2197 DBT *skey; 2198{ 2199 DBT *tskey; 2200 DBTCL_INFO *ip; 2201 Tcl_Interp *interp; 2202 Tcl_Obj *pobj, *dobj, *objv[3], *robj, **skeylist; 2203 size_t len; 2204 int ilen, result, ret; 2205 u_int32_t i, nskeys; 2206 void *retbuf, *databuf; 2207 2208 ip = (DBTCL_INFO *)dbp->api_internal; 2209 interp = ip->i_interp; 2210 objv[0] = ip->i_second_call; 2211 2212 /* 2213 * Create two ByteArray objects, with the contents of the pkey 2214 * and data DBTs that are our inputs. 2215 */ 2216 pobj = Tcl_NewByteArrayObj(pkey->data, (int)pkey->size); 2217 Tcl_IncrRefCount(pobj); 2218 dobj = Tcl_NewByteArrayObj(data->data, (int)data->size); 2219 Tcl_IncrRefCount(dobj); 2220 2221 objv[1] = pobj; 2222 objv[2] = dobj; 2223 2224 result = Tcl_EvalObjv(interp, 3, objv, 0); 2225 2226 Tcl_DecrRefCount(pobj); 2227 Tcl_DecrRefCount(dobj); 2228 2229 if (result != TCL_OK) { 2230 __db_errx(dbp->env, 2231 "Tcl callback function failed with code %d", result); 2232 return (EINVAL); 2233 } 2234 2235 robj = Tcl_GetObjResult(interp); 2236 if (robj->typePtr == NULL || strcmp(robj->typePtr->name, "list") != 0) { 2237 nskeys = 1; 2238 skeylist = &robj; 2239 tskey = skey; 2240 } else { 2241 if ((result = Tcl_ListObjGetElements(interp, 2242 robj, &ilen, &skeylist)) != TCL_OK) { 2243 __db_errx(dbp->env, 2244 "Could not get list elements from Tcl callback"); 2245 return (EINVAL); 2246 } 2247 nskeys = (u_int32_t)ilen; 2248 2249 /* 2250 * It would be nice to check for nskeys == 0 and return 2251 * DB_DONOTINDEX, but Tcl does not distinguish between an empty 2252 * string and an empty list, so that would disallow empty 2253 * secondary keys. 2254 */ 2255 if (nskeys == 0) { 2256 nskeys = 1; 2257 skeylist = &robj; 2258 } 2259 if (nskeys == 1) 2260 tskey = skey; 2261 else { 2262 memset(skey, 0, sizeof(DBT)); 2263 if ((ret = __os_umalloc(dbp->env, 2264 nskeys * sizeof(DBT), &skey->data)) != 0) 2265 return (ret); 2266 skey->size = nskeys; 2267 F_SET(skey, DB_DBT_MULTIPLE | DB_DBT_APPMALLOC); 2268 tskey = (DBT *)skey->data; 2269 } 2270 } 2271 2272 for (i = 0; i < nskeys; i++, tskey++) { 2273 retbuf = Tcl_GetByteArrayFromObj(skeylist[i], &ilen); 2274 len = (size_t)ilen; 2275 2276 /* 2277 * retbuf is owned by Tcl; copy it into malloc'ed memory. 2278 * We need to use __os_umalloc rather than ufree because this 2279 * will be freed by DB using __os_ufree--the DB_DBT_APPMALLOC 2280 * flag tells DB to free application-allocated memory. 2281 */ 2282 if ((ret = __os_umalloc(dbp->env, len, &databuf)) != 0) 2283 return (ret); 2284 memcpy(databuf, retbuf, len); 2285 2286 memset(tskey, 0, sizeof(DBT)); 2287 tskey->data = databuf; 2288 tskey->size = len; 2289 F_SET(tskey, DB_DBT_APPMALLOC); 2290 } 2291 2292 return (0); 2293} 2294 2295/* 2296 * tcl_db_join -- 2297 */ 2298static int 2299tcl_DbJoin(interp, objc, objv, dbp, dbcp) 2300 Tcl_Interp *interp; /* Interpreter */ 2301 int objc; /* How many arguments? */ 2302 Tcl_Obj *CONST objv[]; /* The argument objects */ 2303 DB *dbp; /* Database pointer */ 2304 DBC **dbcp; /* Cursor pointer */ 2305{ 2306 static const char *dbjopts[] = { 2307 "-nosort", 2308 NULL 2309 }; 2310 enum dbjopts { 2311 DBJ_NOSORT 2312 }; 2313 DBC **listp; 2314 size_t size; 2315 u_int32_t flag; 2316 int adj, i, j, optindex, result, ret; 2317 char *arg, msg[MSG_SIZE]; 2318 2319 result = TCL_OK; 2320 flag = 0; 2321 if (objc < 3) { 2322 Tcl_WrongNumArgs(interp, 2, objv, "curs1 curs2 ..."); 2323 return (TCL_ERROR); 2324 } 2325 2326 for (adj = i = 2; i < objc; i++) { 2327 if (Tcl_GetIndexFromObj(interp, objv[i], dbjopts, "option", 2328 TCL_EXACT, &optindex) != TCL_OK) { 2329 result = IS_HELP(objv[i]); 2330 if (result == TCL_OK) 2331 return (result); 2332 result = TCL_OK; 2333 Tcl_ResetResult(interp); 2334 break; 2335 } 2336 switch ((enum dbjopts)optindex) { 2337 case DBJ_NOSORT: 2338 flag |= DB_JOIN_NOSORT; 2339 adj++; 2340 break; 2341 } 2342 } 2343 if (result != TCL_OK) 2344 return (result); 2345 /* 2346 * Allocate one more for NULL ptr at end of list. 2347 */ 2348 size = sizeof(DBC *) * (size_t)((objc - adj) + 1); 2349 ret = __os_malloc(dbp->env, size, &listp); 2350 if (ret != 0) { 2351 Tcl_SetResult(interp, db_strerror(ret), TCL_STATIC); 2352 return (TCL_ERROR); 2353 } 2354 2355 memset(listp, 0, size); 2356 for (j = 0, i = adj; i < objc; i++, j++) { 2357 arg = Tcl_GetStringFromObj(objv[i], NULL); 2358 listp[j] = NAME_TO_DBC(arg); 2359 if (listp[j] == NULL) { 2360 snprintf(msg, MSG_SIZE, 2361 "Join: Invalid cursor: %s\n", arg); 2362 Tcl_SetResult(interp, msg, TCL_VOLATILE); 2363 result = TCL_ERROR; 2364 goto out; 2365 } 2366 } 2367 listp[j] = NULL; 2368 _debug_check(); 2369 ret = dbp->join(dbp, listp, dbcp, flag); 2370 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db join"); 2371 2372out: 2373 __os_free(dbp->env, listp); 2374 return (result); 2375} 2376 2377/* 2378 * tcl_db_getjoin -- 2379 */ 2380static int 2381tcl_DbGetjoin(interp, objc, objv, dbp) 2382 Tcl_Interp *interp; /* Interpreter */ 2383 int objc; /* How many arguments? */ 2384 Tcl_Obj *CONST objv[]; /* The argument objects */ 2385 DB *dbp; /* Database pointer */ 2386{ 2387 static const char *dbgetjopts[] = { 2388#ifdef CONFIG_TEST 2389 "-nosort", 2390#endif 2391 "-txn", 2392 NULL 2393 }; 2394 enum dbgetjopts { 2395#ifdef CONFIG_TEST 2396 DBGETJ_NOSORT, 2397#endif 2398 DBGETJ_TXN 2399 }; 2400 DB_TXN *txn; 2401 DB *elemdbp; 2402 DBC **listp; 2403 DBC *dbc; 2404 DBT key, data; 2405 Tcl_Obj **elemv, *retlist; 2406 void *ktmp; 2407 size_t size; 2408 u_int32_t flag; 2409 int adj, elemc, freekey, i, j, optindex, result, ret; 2410 char *arg, msg[MSG_SIZE]; 2411 2412 result = TCL_OK; 2413 flag = 0; 2414 ktmp = NULL; 2415 freekey = 0; 2416 if (objc < 3) { 2417 Tcl_WrongNumArgs(interp, 2, objv, "{db1 key1} {db2 key2} ..."); 2418 return (TCL_ERROR); 2419 } 2420 2421 txn = NULL; 2422 i = 2; 2423 adj = i; 2424 while (i < objc) { 2425 if (Tcl_GetIndexFromObj(interp, objv[i], dbgetjopts, "option", 2426 TCL_EXACT, &optindex) != TCL_OK) { 2427 result = IS_HELP(objv[i]); 2428 if (result == TCL_OK) 2429 return (result); 2430 result = TCL_OK; 2431 Tcl_ResetResult(interp); 2432 break; 2433 } 2434 i++; 2435 switch ((enum dbgetjopts)optindex) { 2436#ifdef CONFIG_TEST 2437 case DBGETJ_NOSORT: 2438 flag |= DB_JOIN_NOSORT; 2439 adj++; 2440 break; 2441#endif 2442 case DBGETJ_TXN: 2443 if (i == objc) { 2444 Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?"); 2445 result = TCL_ERROR; 2446 break; 2447 } 2448 arg = Tcl_GetStringFromObj(objv[i++], NULL); 2449 txn = NAME_TO_TXN(arg); 2450 adj += 2; 2451 if (txn == NULL) { 2452 snprintf(msg, MSG_SIZE, 2453 "GetJoin: Invalid txn: %s\n", arg); 2454 Tcl_SetResult(interp, msg, TCL_VOLATILE); 2455 result = TCL_ERROR; 2456 } 2457 break; 2458 } 2459 } 2460 if (result != TCL_OK) 2461 return (result); 2462 size = sizeof(DBC *) * (size_t)((objc - adj) + 1); 2463 ret = __os_malloc(NULL, size, &listp); 2464 if (ret != 0) { 2465 Tcl_SetResult(interp, db_strerror(ret), TCL_STATIC); 2466 return (TCL_ERROR); 2467 } 2468 2469 memset(listp, 0, size); 2470 for (j = 0, i = adj; i < objc; i++, j++) { 2471 /* 2472 * Get each sublist as {db key} 2473 */ 2474 result = Tcl_ListObjGetElements(interp, objv[i], 2475 &elemc, &elemv); 2476 if (elemc != 2) { 2477 Tcl_SetResult(interp, "Lists must be {db key}", 2478 TCL_STATIC); 2479 result = TCL_ERROR; 2480 goto out; 2481 } 2482 /* 2483 * Get a pointer to that open db. Then, open a cursor in 2484 * that db, and go to the "key" place. 2485 */ 2486 elemdbp = NAME_TO_DB(Tcl_GetStringFromObj(elemv[0], NULL)); 2487 if (elemdbp == NULL) { 2488 snprintf(msg, MSG_SIZE, "Get_join: Invalid db: %s\n", 2489 Tcl_GetStringFromObj(elemv[0], NULL)); 2490 Tcl_SetResult(interp, msg, TCL_VOLATILE); 2491 result = TCL_ERROR; 2492 goto out; 2493 } 2494 ret = elemdbp->cursor(elemdbp, txn, &listp[j], 0); 2495 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 2496 "db cursor")) == TCL_ERROR) 2497 goto out; 2498 memset(&key, 0, sizeof(key)); 2499 memset(&data, 0, sizeof(data)); 2500 ret = _CopyObjBytes(interp, elemv[elemc-1], &ktmp, 2501 &key.size, &freekey); 2502 if (ret != 0) { 2503 result = _ReturnSetup(interp, ret, 2504 DB_RETOK_STD(ret), "db join"); 2505 goto out; 2506 } 2507 key.data = ktmp; 2508 ret = (listp[j])->get(listp[j], &key, &data, DB_SET); 2509 if ((result = _ReturnSetup(interp, ret, DB_RETOK_DBCGET(ret), 2510 "db cget")) == TCL_ERROR) 2511 goto out; 2512 } 2513 listp[j] = NULL; 2514 _debug_check(); 2515 ret = dbp->join(dbp, listp, &dbc, flag); 2516 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db join"); 2517 if (result == TCL_ERROR) 2518 goto out; 2519 2520 retlist = Tcl_NewListObj(0, NULL); 2521 while (ret == 0 && result == TCL_OK) { 2522 memset(&key, 0, sizeof(key)); 2523 memset(&data, 0, sizeof(data)); 2524 key.flags |= DB_DBT_MALLOC; 2525 data.flags |= DB_DBT_MALLOC; 2526 ret = dbc->get(dbc, &key, &data, 0); 2527 /* 2528 * Build up our {name value} sublist 2529 */ 2530 if (ret == 0) { 2531 result = _SetListElem(interp, retlist, 2532 key.data, key.size, 2533 data.data, data.size); 2534 __os_ufree(dbp->env, key.data); 2535 __os_ufree(dbp->env, data.data); 2536 } 2537 } 2538 (void)dbc->close(dbc); 2539 if (result == TCL_OK) 2540 Tcl_SetObjResult(interp, retlist); 2541out: 2542 if (ktmp != NULL && freekey) 2543 __os_free(dbp->env, ktmp); 2544 while (j) { 2545 if (listp[j]) 2546 (void)(listp[j])->close(listp[j]); 2547 j--; 2548 } 2549 __os_free(dbp->env, listp); 2550 return (result); 2551} 2552 2553/* 2554 * tcl_DbGetFlags -- 2555 */ 2556static int 2557tcl_DbGetFlags(interp, objc, objv, dbp) 2558 Tcl_Interp *interp; /* Interpreter */ 2559 int objc; /* How many arguments? */ 2560 Tcl_Obj *CONST objv[]; /* The argument objects */ 2561 DB *dbp; /* Database pointer */ 2562{ 2563 int i, ret, result; 2564 u_int32_t flags; 2565 char buf[512]; 2566 Tcl_Obj *res; 2567 2568 static const struct { 2569 u_int32_t flag; 2570 char *arg; 2571 } db_flags[] = { 2572 { DB_CHKSUM, "-chksum" }, 2573 { DB_DUP, "-dup" }, 2574 { DB_DUPSORT, "-dupsort" }, 2575 { DB_ENCRYPT, "-encrypt" }, 2576 { DB_INORDER, "-inorder" }, 2577 { DB_TXN_NOT_DURABLE, "-notdurable" }, 2578 { DB_RECNUM, "-recnum" }, 2579 { DB_RENUMBER, "-renumber" }, 2580 { DB_REVSPLITOFF, "-revsplitoff" }, 2581 { DB_SNAPSHOT, "-snapshot" }, 2582 { 0, NULL } 2583 }; 2584 2585 if (objc != 2) { 2586 Tcl_WrongNumArgs(interp, 1, objv, NULL); 2587 return (TCL_ERROR); 2588 } 2589 2590 ret = dbp->get_flags(dbp, &flags); 2591 if ((result = _ReturnSetup( 2592 interp, ret, DB_RETOK_STD(ret), "db get_flags")) == TCL_OK) { 2593 buf[0] = '\0'; 2594 2595 for (i = 0; db_flags[i].flag != 0; i++) 2596 if (LF_ISSET(db_flags[i].flag)) { 2597 if (strlen(buf) > 0) 2598 (void)strncat(buf, " ", sizeof(buf)); 2599 (void)strncat( 2600 buf, db_flags[i].arg, sizeof(buf)); 2601 } 2602 2603 res = NewStringObj(buf, strlen(buf)); 2604 Tcl_SetObjResult(interp, res); 2605 } 2606 2607 return (result); 2608} 2609 2610/* 2611 * tcl_DbGetOpenFlags -- 2612 */ 2613static int 2614tcl_DbGetOpenFlags(interp, objc, objv, dbp) 2615 Tcl_Interp *interp; /* Interpreter */ 2616 int objc; /* How many arguments? */ 2617 Tcl_Obj *CONST objv[]; /* The argument objects */ 2618 DB *dbp; /* Database pointer */ 2619{ 2620 int i, ret, result; 2621 u_int32_t flags; 2622 char buf[512]; 2623 Tcl_Obj *res; 2624 2625 static const struct { 2626 u_int32_t flag; 2627 char *arg; 2628 } open_flags[] = { 2629 { DB_AUTO_COMMIT, "-auto_commit" }, 2630 { DB_CREATE, "-create" }, 2631 { DB_EXCL, "-excl" }, 2632 { DB_MULTIVERSION, "-multiversion" }, 2633 { DB_NOMMAP, "-nommap" }, 2634 { DB_RDONLY, "-rdonly" }, 2635 { DB_READ_UNCOMMITTED, "-read_uncommitted" }, 2636 { DB_THREAD, "-thread" }, 2637 { DB_TRUNCATE, "-truncate" }, 2638 { 0, NULL } 2639 }; 2640 2641 if (objc != 2) { 2642 Tcl_WrongNumArgs(interp, 1, objv, NULL); 2643 return (TCL_ERROR); 2644 } 2645 2646 ret = dbp->get_open_flags(dbp, &flags); 2647 if ((result = _ReturnSetup( 2648 interp, ret, DB_RETOK_STD(ret), "db get_open_flags")) == TCL_OK) { 2649 buf[0] = '\0'; 2650 2651 for (i = 0; open_flags[i].flag != 0; i++) 2652 if (LF_ISSET(open_flags[i].flag)) { 2653 if (strlen(buf) > 0) 2654 (void)strncat(buf, " ", sizeof(buf)); 2655 (void)strncat( 2656 buf, open_flags[i].arg, sizeof(buf)); 2657 } 2658 2659 res = NewStringObj(buf, strlen(buf)); 2660 Tcl_SetObjResult(interp, res); 2661 } 2662 2663 return (result); 2664} 2665 2666/* 2667 * tcl_DbCount -- 2668 */ 2669static int 2670tcl_DbCount(interp, objc, objv, dbp) 2671 Tcl_Interp *interp; /* Interpreter */ 2672 int objc; /* How many arguments? */ 2673 Tcl_Obj *CONST objv[]; /* The argument objects */ 2674 DB *dbp; /* Database pointer */ 2675{ 2676 DBC *dbc; 2677 DBT key, data; 2678 Tcl_Obj *res; 2679 void *ktmp; 2680 db_recno_t count, recno; 2681 int freekey, result, ret; 2682 2683 res = NULL; 2684 count = 0; 2685 freekey = ret = 0; 2686 ktmp = NULL; 2687 result = TCL_OK; 2688 2689 if (objc != 3) { 2690 Tcl_WrongNumArgs(interp, 2, objv, "key"); 2691 return (TCL_ERROR); 2692 } 2693 2694 /* 2695 * Get the count for our key. 2696 * We do this by getting a cursor for this DB. Moving the cursor 2697 * to the set location, and getting a count on that cursor. 2698 */ 2699 memset(&key, 0, sizeof(key)); 2700 memset(&data, 0, sizeof(data)); 2701 2702 /* 2703 * If it's a queue or recno database, we must make sure to 2704 * treat the key as a recno rather than as a byte string. 2705 */ 2706 if (dbp->type == DB_RECNO || dbp->type == DB_QUEUE) { 2707 result = _GetUInt32(interp, objv[2], &recno); 2708 if (result == TCL_OK) { 2709 key.data = &recno; 2710 key.size = sizeof(db_recno_t); 2711 } else 2712 return (result); 2713 } else { 2714 ret = _CopyObjBytes(interp, objv[2], &ktmp, 2715 &key.size, &freekey); 2716 if (ret != 0) { 2717 result = _ReturnSetup(interp, ret, 2718 DB_RETOK_STD(ret), "db count"); 2719 return (result); 2720 } 2721 key.data = ktmp; 2722 } 2723 _debug_check(); 2724 ret = dbp->cursor(dbp, NULL, &dbc, 0); 2725 if (ret != 0) { 2726 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 2727 "db cursor"); 2728 goto out; 2729 } 2730 /* 2731 * Move our cursor to the key. 2732 */ 2733 ret = dbc->get(dbc, &key, &data, DB_SET); 2734 if (ret == DB_KEYEMPTY || ret == DB_NOTFOUND) 2735 count = 0; 2736 else { 2737 ret = dbc->count(dbc, &count, 0); 2738 if (ret != 0) { 2739 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 2740 "db c count"); 2741 goto out; 2742 } 2743 } 2744 res = Tcl_NewWideIntObj((Tcl_WideInt)count); 2745 Tcl_SetObjResult(interp, res); 2746 2747out: if (ktmp != NULL && freekey) 2748 __os_free(dbp->env, ktmp); 2749 (void)dbc->close(dbc); 2750 return (result); 2751} 2752 2753#ifdef CONFIG_TEST 2754/* 2755 * tcl_DbKeyRange -- 2756 */ 2757static int 2758tcl_DbKeyRange(interp, objc, objv, dbp) 2759 Tcl_Interp *interp; /* Interpreter */ 2760 int objc; /* How many arguments? */ 2761 Tcl_Obj *CONST objv[]; /* The argument objects */ 2762 DB *dbp; /* Database pointer */ 2763{ 2764 static const char *dbkeyropts[] = { 2765 "-txn", 2766 NULL 2767 }; 2768 enum dbkeyropts { 2769 DBKEYR_TXN 2770 }; 2771 DB_TXN *txn; 2772 DB_KEY_RANGE range; 2773 DBT key; 2774 DBTYPE type; 2775 Tcl_Obj *myobjv[3], *retlist; 2776 void *ktmp; 2777 db_recno_t recno; 2778 u_int32_t flag; 2779 int freekey, i, myobjc, optindex, result, ret; 2780 char *arg, msg[MSG_SIZE]; 2781 2782 ktmp = NULL; 2783 flag = 0; 2784 freekey = 0; 2785 result = TCL_OK; 2786 if (objc < 3) { 2787 Tcl_WrongNumArgs(interp, 2, objv, "?-txn id? key"); 2788 return (TCL_ERROR); 2789 } 2790 2791 txn = NULL; 2792 for (i = 2; i < objc;) { 2793 if (Tcl_GetIndexFromObj(interp, objv[i], dbkeyropts, "option", 2794 TCL_EXACT, &optindex) != TCL_OK) { 2795 result = IS_HELP(objv[i]); 2796 if (result == TCL_OK) 2797 return (result); 2798 result = TCL_OK; 2799 Tcl_ResetResult(interp); 2800 break; 2801 } 2802 i++; 2803 switch ((enum dbkeyropts)optindex) { 2804 case DBKEYR_TXN: 2805 if (i == objc) { 2806 Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?"); 2807 result = TCL_ERROR; 2808 break; 2809 } 2810 arg = Tcl_GetStringFromObj(objv[i++], NULL); 2811 txn = NAME_TO_TXN(arg); 2812 if (txn == NULL) { 2813 snprintf(msg, MSG_SIZE, 2814 "KeyRange: Invalid txn: %s\n", arg); 2815 Tcl_SetResult(interp, msg, TCL_VOLATILE); 2816 result = TCL_ERROR; 2817 } 2818 break; 2819 } 2820 } 2821 if (result != TCL_OK) 2822 return (result); 2823 (void)dbp->get_type(dbp, &type); 2824 ret = 0; 2825 /* 2826 * Make sure we have a key. 2827 */ 2828 if (i != (objc - 1)) { 2829 Tcl_WrongNumArgs(interp, 2, objv, "?args? key"); 2830 result = TCL_ERROR; 2831 goto out; 2832 } 2833 memset(&key, 0, sizeof(key)); 2834 if (type == DB_RECNO || type == DB_QUEUE) { 2835 result = _GetUInt32(interp, objv[i], &recno); 2836 if (result == TCL_OK) { 2837 key.data = &recno; 2838 key.size = sizeof(db_recno_t); 2839 } else 2840 return (result); 2841 } else { 2842 ret = _CopyObjBytes(interp, objv[i++], &ktmp, 2843 &key.size, &freekey); 2844 if (ret != 0) { 2845 result = _ReturnSetup(interp, ret, 2846 DB_RETOK_STD(ret), "db keyrange"); 2847 return (result); 2848 } 2849 key.data = ktmp; 2850 } 2851 _debug_check(); 2852 ret = dbp->key_range(dbp, txn, &key, &range, flag); 2853 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db keyrange"); 2854 if (result == TCL_ERROR) 2855 goto out; 2856 2857 /* 2858 * If we succeeded, set up return list. 2859 */ 2860 myobjc = 3; 2861 myobjv[0] = Tcl_NewDoubleObj(range.less); 2862 myobjv[1] = Tcl_NewDoubleObj(range.equal); 2863 myobjv[2] = Tcl_NewDoubleObj(range.greater); 2864 retlist = Tcl_NewListObj(myobjc, myobjv); 2865 if (result == TCL_OK) 2866 Tcl_SetObjResult(interp, retlist); 2867 2868out: if (ktmp != NULL && freekey) 2869 __os_free(dbp->env, ktmp); 2870 return (result); 2871} 2872#endif 2873 2874/* 2875 * tcl_DbTruncate -- 2876 */ 2877static int 2878tcl_DbTruncate(interp, objc, objv, dbp) 2879 Tcl_Interp *interp; /* Interpreter */ 2880 int objc; /* How many arguments? */ 2881 Tcl_Obj *CONST objv[]; /* The argument objects */ 2882 DB *dbp; /* Database pointer */ 2883{ 2884 static const char *dbcuropts[] = { 2885 "-txn", 2886 NULL 2887 }; 2888 enum dbcuropts { 2889 DBTRUNC_TXN 2890 }; 2891 DB_TXN *txn; 2892 Tcl_Obj *res; 2893 u_int32_t count; 2894 int i, optindex, result, ret; 2895 char *arg, msg[MSG_SIZE]; 2896 2897 txn = NULL; 2898 result = TCL_OK; 2899 2900 i = 2; 2901 while (i < objc) { 2902 if (Tcl_GetIndexFromObj(interp, objv[i], dbcuropts, "option", 2903 TCL_EXACT, &optindex) != TCL_OK) { 2904 result = IS_HELP(objv[i]); 2905 goto out; 2906 } 2907 i++; 2908 switch ((enum dbcuropts)optindex) { 2909 case DBTRUNC_TXN: 2910 if (i == objc) { 2911 Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?"); 2912 result = TCL_ERROR; 2913 break; 2914 } 2915 arg = Tcl_GetStringFromObj(objv[i++], NULL); 2916 txn = NAME_TO_TXN(arg); 2917 if (txn == NULL) { 2918 snprintf(msg, MSG_SIZE, 2919 "Truncate: Invalid txn: %s\n", arg); 2920 Tcl_SetResult(interp, msg, TCL_VOLATILE); 2921 result = TCL_ERROR; 2922 } 2923 break; 2924 } 2925 if (result != TCL_OK) 2926 break; 2927 } 2928 if (result != TCL_OK) 2929 goto out; 2930 2931 _debug_check(); 2932 ret = dbp->truncate(dbp, txn, &count, 0); 2933 if (ret != 0) 2934 result = _ErrorSetup(interp, ret, "db truncate"); 2935 2936 else { 2937 res = Tcl_NewWideIntObj((Tcl_WideInt)count); 2938 Tcl_SetObjResult(interp, res); 2939 } 2940out: 2941 return (result); 2942} 2943 2944#ifdef CONFIG_TEST 2945/* 2946 * tcl_DbCompact -- 2947 */ 2948static int 2949tcl_DbCompact(interp, objc, objv, dbp) 2950 Tcl_Interp *interp; /* Interpreter */ 2951 int objc; /* How many arguments? */ 2952 Tcl_Obj *CONST objv[]; /* The argument objects */ 2953 DB *dbp; /* Database pointer */ 2954{ 2955 static const char *dbcuropts[] = { 2956 "-fillpercent", 2957 "-freespace", 2958 "-freeonly", 2959 "-pages", 2960 "-start", 2961 "-stop", 2962 "-timeout", 2963 "-txn", 2964 NULL 2965 }; 2966 enum dbcuropts { 2967 DBREORG_FILLFACTOR, 2968 DBREORG_FREESPACE, 2969 DBREORG_FREEONLY, 2970 DBREORG_PAGES, 2971 DBREORG_START, 2972 DBREORG_STOP, 2973 DBREORG_TIMEOUT, 2974 DBREORG_TXN 2975 }; 2976 DBTCL_INFO *ip; 2977 DBT *key, end, start, stop; 2978 DBTYPE type; 2979 DB_TXN *txn; 2980 Tcl_Obj *myobj, *retlist; 2981 db_recno_t recno, srecno; 2982 u_int32_t arg, fillfactor, flags, pages, timeout; 2983 char *carg, msg[MSG_SIZE]; 2984 int freekey, i, optindex, result, ret; 2985 void *kp; 2986 2987 flags = 0; 2988 result = TCL_OK; 2989 txn = NULL; 2990 (void)dbp->get_type(dbp, &type); 2991 memset(&start, 0, sizeof(start)); 2992 memset(&stop, 0, sizeof(stop)); 2993 memset(&end, 0, sizeof(end)); 2994 ip = (DBTCL_INFO *)dbp->api_internal; 2995 fillfactor = pages = timeout = 0; 2996 2997 i = 2; 2998 while (i < objc) { 2999 if (Tcl_GetIndexFromObj(interp, objv[i], dbcuropts, "option", 3000 TCL_EXACT, &optindex) != TCL_OK) { 3001 result = IS_HELP(objv[i]); 3002 goto out; 3003 } 3004 i++; 3005 switch ((enum dbcuropts)optindex) { 3006 case DBREORG_FILLFACTOR: 3007 if (i == objc) { 3008 Tcl_WrongNumArgs(interp, 3009 2, objv, "?-fillfactor number?"); 3010 result = TCL_ERROR; 3011 break; 3012 } 3013 result = _GetUInt32(interp, objv[i++], &arg); 3014 if (result != TCL_OK) 3015 goto out; 3016 i++; 3017 fillfactor = arg; 3018 break; 3019 case DBREORG_FREESPACE: 3020 LF_SET(DB_FREE_SPACE); 3021 break; 3022 3023 case DBREORG_FREEONLY: 3024 LF_SET(DB_FREELIST_ONLY); 3025 break; 3026 3027 case DBREORG_PAGES: 3028 if (i == objc) { 3029 Tcl_WrongNumArgs(interp, 3030 2, objv, "?-pages number?"); 3031 result = TCL_ERROR; 3032 break; 3033 } 3034 result = _GetUInt32(interp, objv[i++], &arg); 3035 if (result != TCL_OK) 3036 goto out; 3037 i++; 3038 pages = arg; 3039 break; 3040 case DBREORG_TIMEOUT: 3041 if (i == objc) { 3042 Tcl_WrongNumArgs(interp, 3043 2, objv, "?-timeout number?"); 3044 result = TCL_ERROR; 3045 break; 3046 } 3047 result = _GetUInt32(interp, objv[i++], &arg); 3048 if (result != TCL_OK) 3049 goto out; 3050 i++; 3051 timeout = arg; 3052 break; 3053 3054 case DBREORG_START: 3055 case DBREORG_STOP: 3056 if (i == objc) { 3057 Tcl_WrongNumArgs(interp, 1, objv, 3058 "?-args? -start/stop key"); 3059 result = TCL_ERROR; 3060 goto out; 3061 } 3062 if ((enum dbcuropts)optindex == DBREORG_START) { 3063 key = &start; 3064 key->data = &recno; 3065 } else { 3066 key = &stop; 3067 key->data = &srecno; 3068 } 3069 if (type == DB_RECNO || type == DB_QUEUE) { 3070 result = _GetUInt32( 3071 interp, objv[i], key->data); 3072 if (result == TCL_OK) { 3073 key->size = sizeof(db_recno_t); 3074 } else 3075 goto out; 3076 } else { 3077 ret = _CopyObjBytes(interp, objv[i], 3078 &key->data, &key->size, &freekey); 3079 if (ret != 0) 3080 goto err; 3081 if (freekey == 0) { 3082 if ((ret = __os_malloc(NULL, 3083 key->size, &kp)) != 0) 3084 goto err; 3085 3086 memcpy(kp, key->data, key->size); 3087 key->data = kp; 3088 key->ulen = key->size; 3089 } 3090 } 3091 i++; 3092 break; 3093 case DBREORG_TXN: 3094 if (i == objc) { 3095 Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?"); 3096 result = TCL_ERROR; 3097 break; 3098 } 3099 carg = Tcl_GetStringFromObj(objv[i++], NULL); 3100 txn = NAME_TO_TXN(carg); 3101 if (txn == NULL) { 3102 snprintf(msg, MSG_SIZE, 3103 "Compact: Invalid txn: %s\n", carg); 3104 Tcl_SetResult(interp, msg, TCL_VOLATILE); 3105 result = TCL_ERROR; 3106 } 3107 } 3108 if (result != TCL_OK) 3109 break; 3110 } 3111 if (result != TCL_OK) 3112 goto out; 3113 3114 if (ip->i_cdata == NULL) 3115 if ((ret = __os_calloc(dbp->env, 3116 1, sizeof(DB_COMPACT), &ip->i_cdata)) != 0) { 3117 Tcl_SetResult(interp, 3118 db_strerror(ret), TCL_STATIC); 3119 goto out; 3120 } 3121 3122 ip->i_cdata->compact_fillpercent = fillfactor; 3123 ip->i_cdata->compact_timeout = timeout; 3124 ip->i_cdata->compact_pages = pages; 3125 3126 _debug_check(); 3127 ret = dbp->compact(dbp, txn, &start, &stop, ip->i_cdata, flags, &end); 3128 result = _ReturnSetup(interp, ret, DB_RETOK_DBCGET(ret), "dbp compact"); 3129 if (result == TCL_ERROR) 3130 goto out; 3131 3132 retlist = Tcl_NewListObj(0, NULL); 3133 if (ret != 0) 3134 goto out; 3135 if (type == DB_RECNO || type == DB_QUEUE) { 3136 if (end.size == 0) 3137 recno = 0; 3138 else 3139 recno = *((db_recno_t *)end.data); 3140 myobj = Tcl_NewWideIntObj((Tcl_WideInt)recno); 3141 } else 3142 myobj = Tcl_NewByteArrayObj(end.data, (int)end.size); 3143 result = Tcl_ListObjAppendElement(interp, retlist, myobj); 3144 if (result == TCL_OK) 3145 Tcl_SetObjResult(interp, retlist); 3146 3147 if (0) { 3148err: result = _ReturnSetup(interp, 3149 ret, DB_RETOK_DBCGET(ret), "dbc compact"); 3150 } 3151out: 3152 if (start.data != NULL && start.data != &recno) 3153 __os_free(NULL, start.data); 3154 if (stop.data != NULL && stop.data != &srecno) 3155 __os_free(NULL, stop.data); 3156 if (end.data != NULL) 3157 __os_free(NULL, end.data); 3158 3159 return (result); 3160} 3161 3162/* 3163 * tcl_DbCompactStat 3164 */ 3165static int 3166tcl_DbCompactStat(interp, objc, objv, dbp) 3167 Tcl_Interp *interp; /* Interpreter */ 3168 int objc; /* How many arguments? */ 3169 Tcl_Obj *CONST objv[]; /* The argument objects */ 3170 DB *dbp; /* Database pointer */ 3171{ 3172 DBTCL_INFO *ip; 3173 3174 COMPQUIET(objc, 0); 3175 COMPQUIET(objv, NULL); 3176 3177 ip = (DBTCL_INFO *)dbp->api_internal; 3178 3179 return (tcl_CompactStat(interp, ip)); 3180} 3181 3182/* 3183 * PUBLIC: int tcl_CompactStat __P((Tcl_Interp *, DBTCL_INFO *)); 3184 */ 3185int 3186tcl_CompactStat(interp, ip) 3187 Tcl_Interp *interp; /* Interpreter */ 3188 DBTCL_INFO *ip; 3189{ 3190 DB_COMPACT *rp; 3191 Tcl_Obj *res; 3192 int result; 3193 char msg[MSG_SIZE]; 3194 3195 result = TCL_OK; 3196 rp = NULL; 3197 3198 _debug_check(); 3199 if ((rp = ip->i_cdata) == NULL) { 3200 snprintf(msg, MSG_SIZE, 3201 "Compact stat: No stats available\n"); 3202 Tcl_SetResult(interp, msg, TCL_VOLATILE); 3203 result = TCL_ERROR; 3204 goto error; 3205 } 3206 3207 res = Tcl_NewObj(); 3208 3209 MAKE_STAT_LIST("Pages freed", rp->compact_pages_free); 3210 MAKE_STAT_LIST("Pages truncated", rp->compact_pages_truncated); 3211 MAKE_STAT_LIST("Pages examined", rp->compact_pages_examine); 3212 MAKE_STAT_LIST("Levels removed", rp->compact_levels); 3213 MAKE_STAT_LIST("Deadlocks encountered", rp->compact_deadlock); 3214 3215 Tcl_SetObjResult(interp, res); 3216error: 3217 return (result); 3218} 3219#endif 3220