开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 数据库系统 > MySQL数据库 > 查看源码
tcl_db_pkg.c
资源名称：mysql-4.1.16-win-src.zip　[点击查看]
上传用户：romrleung
上传日期：2022-05-23
资源大小：18897k
文件大小：74k
源码类别：

MySQL数据库

开发平台：

Visual C++

tcl_db_pkg.c：源码内容
  1. /*-
  2.  * See the file LICENSE for redistribution information.
  3.  *
  4.  * Copyright (c) 1999-2002
  5.  * Sleepycat Software.  All rights reserved.
  6.  */
  8. #include "db_config.h"
  10. #ifndef lint
  11. static const char revid[] = "$Id: tcl_db_pkg.c,v 11.141 2002/08/14 20:15:47 bostic Exp $";
  12. #endif /* not lint */
  14. #ifndef NO_SYSTEM_INCLUDES
  15. #include <sys/types.h>
  17. #include <stdlib.h>
  18. #include <string.h>
  19. #include <tcl.h>
  20. #endif
  22. #if CONFIG_TEST
  23. #define DB_DBM_HSEARCH 1
  24. #endif
  26. #include "db_int.h"
  27. #include "dbinc/db_page.h"
  28. #include "dbinc/hash.h"
  29. #include "dbinc/tcl_db.h"
  31. /* XXX we must declare global data in just one place */
  32. DBTCL_GLOBAL __dbtcl_global;
  34. /*
  35.  * Prototypes for procedures defined later in this file:
  36.  */
  37. static int berkdb_Cmd __P((ClientData, Tcl_Interp *, int,
  38.     Tcl_Obj * CONST*));
  39. static int bdb_EnvOpen __P((Tcl_Interp *, int, Tcl_Obj * CONST*,
  40.     DBTCL_INFO *, DB_ENV **));
  41. static int bdb_DbOpen __P((Tcl_Interp *, int, Tcl_Obj * CONST*,
  42.     DBTCL_INFO *, DB **));
  43. static int bdb_DbRemove __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
  44. static int bdb_DbRename __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
  45. static int bdb_DbUpgrade __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
  46. static int bdb_DbVerify __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
  47. static int bdb_Version __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
  48. static int bdb_Handles __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
  50. static int tcl_bt_compare __P((DB *, const DBT *, const DBT *));
  51. static int tcl_compare_callback __P((DB *, const DBT *, const DBT *,
  52.     Tcl_Obj *, char *));
  53. static int tcl_dup_compare __P((DB *, const DBT *, const DBT *));
  54. static u_int32_t tcl_h_hash __P((DB *, const void *, u_int32_t));
  55. static int tcl_rep_send __P((DB_ENV *,
  56.     const DBT *, const DBT *, int, u_int32_t));
  58. #ifdef TEST_ALLOC
  59. static void * tcl_db_malloc __P((size_t));
  60. static void * tcl_db_realloc __P((void *, size_t));
  61. static void tcl_db_free __P((void *));
  62. #endif
  64. /*
  65.  * Db_tcl_Init --
  66.  *
  67.  * This is a package initialization procedure, which is called by Tcl when
  68.  * this package is to be added to an interpreter.  The name is based on the
  69.  * name of the shared library, currently libdb_tcl-X.Y.so, which Tcl uses
  70.  * to determine the name of this function.
  71.  */
  72. int
  73. Db_tcl_Init(interp)
  74. Tcl_Interp *interp; /* Interpreter in which the package is
  75.  * to be made available. */
  76. {
  77. int code;
  79. code = Tcl_PkgProvide(interp, "Db_tcl", "1.0");
  80. if (code != TCL_OK)
  81. return (code);
  83. Tcl_CreateObjCommand(interp, "berkdb", (Tcl_ObjCmdProc *)berkdb_Cmd,
  84.     (ClientData)0, NULL);
  85. /*
  86.  * Create shared global debugging variables
  87.  */
  88. Tcl_LinkVar(interp, "__debug_on", (char *)&__debug_on, TCL_LINK_INT);
  89. Tcl_LinkVar(interp, "__debug_print", (char *)&__debug_print,
  90.     TCL_LINK_INT);
  91. Tcl_LinkVar(interp, "__debug_stop", (char *)&__debug_stop,
  92.     TCL_LINK_INT);
  93. Tcl_LinkVar(interp, "__debug_test", (char *)&__debug_test,
  94.     TCL_LINK_INT);
  95. LIST_INIT(&__db_infohead);
  96. return (TCL_OK);
  97. }
  99. /*
  100.  * berkdb_cmd --
  101.  * Implements the "berkdb" command.
  102.  * This command supports three sub commands:
  103.  * berkdb version - Returns a list {major minor patch}
  104.  * berkdb env - Creates a new DB_ENV and returns a binding
  105.  *   to a new command of the form dbenvX, where X is an
  106.  *   integer starting at 0 (dbenv0, dbenv1, ...)
  107.  * berkdb open - Creates a new DB (optionally within
  108.  *   the given environment.  Returns a binding to a new
  109.  *   command of the form dbX, where X is an integer
  110.  *   starting at 0 (db0, db1, ...)
  111.  */
  112. static int
  113. berkdb_Cmd(notused, interp, objc, objv)
  114. ClientData notused; /* Not used. */
  115. Tcl_Interp *interp; /* Interpreter */
  116. int objc; /* How many arguments? */
  117. Tcl_Obj *CONST objv[]; /* The argument objects */
  118. {
  119. static char *berkdbcmds[] = {
  120. #if CONFIG_TEST
  121. "dbverify",
  122. "handles",
  123. "upgrade",
  124. #endif
  125. "dbremove",
  126. "dbrename",
  127. "env",
  128. "envremove",
  129. "open",
  130. "version",
  131. #if CONFIG_TEST
  132. /* All below are compatibility functions */
  133. "hcreate", "hsearch", "hdestroy",
  134. "dbminit", "fetch", "store",
  135. "delete", "firstkey", "nextkey",
  136. "ndbm_open", "dbmclose",
  137. #endif
  138. /* All below are convenience functions */
  139. "rand", "random_int", "srand",
  140. "debug_check",
  141. NULL
  142. };
  143. /*
  144.  * All commands enums below ending in X are compatibility
  145.  */
  146. enum berkdbcmds {
  147. #if CONFIG_TEST
  148. BDB_DBVERIFY,
  149. BDB_HANDLES,
  150. BDB_UPGRADE,
  151. #endif
  152. BDB_DBREMOVE,
  153. BDB_DBRENAME,
  154. BDB_ENV,
  155. BDB_ENVREMOVE,
  156. BDB_OPEN,
  157. BDB_VERSION,
  158. #if CONFIG_TEST
  159. BDB_HCREATEX, BDB_HSEARCHX, BDB_HDESTROYX,
  160. BDB_DBMINITX, BDB_FETCHX, BDB_STOREX,
  161. BDB_DELETEX, BDB_FIRSTKEYX, BDB_NEXTKEYX,
  162. BDB_NDBMOPENX, BDB_DBMCLOSEX,
  163. #endif
  164. BDB_RANDX, BDB_RAND_INTX, BDB_SRANDX,
  165. BDB_DBGCKX
  166. };
  167. static int env_id = 0;
  168. static int db_id = 0;
  170. DB *dbp;
  171. #if CONFIG_TEST
  172. DBM *ndbmp;
  173. static int ndbm_id = 0;
  174. #endif
  175. DBTCL_INFO *ip;
  176. DB_ENV *envp;
  177. Tcl_Obj *res;
  178. int cmdindex, result;
  179. char newname[MSG_SIZE];
  181. COMPQUIET(notused, NULL);
  183. Tcl_ResetResult(interp);
  184. memset(newname, 0, MSG_SIZE);
  185. result = TCL_OK;
  186. if (objc <= 1) {
  187. Tcl_WrongNumArgs(interp, 1, objv, "command cmdargs");
  188. return (TCL_ERROR);
  189. }
  191. /*
  192.  * Get the command name index from the object based on the berkdbcmds
  193.  * defined above.
  194.  */
  195. if (Tcl_GetIndexFromObj(interp,
  196.     objv[1], berkdbcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
  197. return (IS_HELP(objv[1]));
  198. res = NULL;
  199. switch ((enum berkdbcmds)cmdindex) {
  200. #if CONFIG_TEST
  201. case BDB_DBVERIFY:
  202. result = bdb_DbVerify(interp, objc, objv);
  203. break;
  204. case BDB_HANDLES:
  205. result = bdb_Handles(interp, objc, objv);
  206. break;
  207. case BDB_UPGRADE:
  208. result = bdb_DbUpgrade(interp, objc, objv);
  209. break;
  210. #endif
  211. case BDB_VERSION:
  212. _debug_check();
  213. result = bdb_Version(interp, objc, objv);
  214. break;
  215. case BDB_ENV:
  216. snprintf(newname, sizeof(newname), "env%d", env_id);
  217. ip = _NewInfo(interp, NULL, newname, I_ENV);
  218. if (ip != NULL) {
  219. result = bdb_EnvOpen(interp, objc, objv, ip, &envp);
  220. if (result == TCL_OK && envp != NULL) {
  221. env_id++;
  222. Tcl_CreateObjCommand(interp, newname,
  223.     (Tcl_ObjCmdProc *)env_Cmd,
  224.     (ClientData)envp, NULL);
  225. /* Use ip->i_name - newname is overwritten */
  226. res =
  227.     Tcl_NewStringObj(newname, strlen(newname));
  228. _SetInfoData(ip, envp);
  229. } else
  230. _DeleteInfo(ip);
  231. } else {
  232. Tcl_SetResult(interp, "Could not set up info",
  233.     TCL_STATIC);
  234. result = TCL_ERROR;
  235. }
  236. break;
  237. case BDB_DBREMOVE:
  238. result = bdb_DbRemove(interp, objc, objv);
  239. break;
  240. case BDB_DBRENAME:
  241. result = bdb_DbRename(interp, objc, objv);
  242. break;
  243. case BDB_ENVREMOVE:
  244. result = tcl_EnvRemove(interp, objc, objv, NULL, NULL);
  245. break;
  246. case BDB_OPEN:
  247. snprintf(newname, sizeof(newname), "db%d", db_id);
  248. ip = _NewInfo(interp, NULL, newname, I_DB);
  249. if (ip != NULL) {
  250. result = bdb_DbOpen(interp, objc, objv, ip, &dbp);
  251. if (result == TCL_OK && dbp != NULL) {
  252. db_id++;
  253. Tcl_CreateObjCommand(interp, newname,
  254.     (Tcl_ObjCmdProc *)db_Cmd,
  255.     (ClientData)dbp, NULL);
  256. /* Use ip->i_name - newname is overwritten */
  257. res =
  258.     Tcl_NewStringObj(newname, strlen(newname));
  259. _SetInfoData(ip, dbp);
  260. } else
  261. _DeleteInfo(ip);
  262. } else {
  263. Tcl_SetResult(interp, "Could not set up info",
  264.     TCL_STATIC);
  265. result = TCL_ERROR;
  266. }
  267. break;
  268. #if CONFIG_TEST
  269. case BDB_HCREATEX:
  270. case BDB_HSEARCHX:
  271. case BDB_HDESTROYX:
  272. result = bdb_HCommand(interp, objc, objv);
  273. break;
  274. case BDB_DBMINITX:
  275. case BDB_DBMCLOSEX:
  276. case BDB_FETCHX:
  277. case BDB_STOREX:
  278. case BDB_DELETEX:
  279. case BDB_FIRSTKEYX:
  280. case BDB_NEXTKEYX:
  281. result = bdb_DbmCommand(interp, objc, objv, DBTCL_DBM, NULL);
  282. break;
  283. case BDB_NDBMOPENX:
  284. snprintf(newname, sizeof(newname), "ndbm%d", ndbm_id);
  285. ip = _NewInfo(interp, NULL, newname, I_NDBM);
  286. if (ip != NULL) {
  287. result = bdb_NdbmOpen(interp, objc, objv, &ndbmp);
  288. if (result == TCL_OK) {
  289. ndbm_id++;
  290. Tcl_CreateObjCommand(interp, newname,
  291.     (Tcl_ObjCmdProc *)ndbm_Cmd,
  292.     (ClientData)ndbmp, NULL);
  293. /* Use ip->i_name - newname is overwritten */
  294. res =
  295.     Tcl_NewStringObj(newname, strlen(newname));
  296. _SetInfoData(ip, ndbmp);
  297. } else
  298. _DeleteInfo(ip);
  299. } else {
  300. Tcl_SetResult(interp, "Could not set up info",
  301.     TCL_STATIC);
  302. result = TCL_ERROR;
  303. }
  304. break;
  305. #endif
  306. case BDB_RANDX:
  307. case BDB_RAND_INTX:
  308. case BDB_SRANDX:
  309. result = bdb_RandCommand(interp, objc, objv);
  310. break;
  311. case BDB_DBGCKX:
  312. _debug_check();
  313. res = Tcl_NewIntObj(0);
  314. break;
  315. }
  316. /*
  317.  * For each different arg call different function to create
  318.  * new commands (or if version, get/return it).
  319.  */
  320. if (result == TCL_OK && res != NULL)
  321. Tcl_SetObjResult(interp, res);
  322. return (result);
  323. }
  325. /*
  326.  * bdb_EnvOpen -
  327.  * Implements the environment open command.
  328.  * There are many, many options to the open command.
  329.  * Here is the general flow:
  330.  *
  331.  * 1.  Call db_env_create to create the env handle.
  332.  * 2.  Parse args tracking options.
  333.  * 3.  Make any pre-open setup calls necessary.
  334.  * 4.  Call DB_ENV->open to open the env.
  335.  * 5.  Return env widget handle to user.
  336.  */
  337. static int
  338. bdb_EnvOpen(interp, objc, objv, ip, env)
  339. Tcl_Interp *interp; /* Interpreter */
  340. int objc; /* How many arguments? */
  341. Tcl_Obj *CONST objv[]; /* The argument objects */
  342. DBTCL_INFO *ip; /* Our internal info */
  343. DB_ENV **env; /* Environment pointer */
  344. {
  345. static char *envopen[] = {
  346. #if CONFIG_TEST
  347. "-auto_commit",
  348. "-cdb",
  349. "-cdb_alldb",
  350. "-client_timeout",
  351. "-lock",
  352. "-lock_conflict",
  353. "-lock_detect",
  354. "-lock_max",
  355. "-lock_max_locks",
  356. "-lock_max_lockers",
  357. "-lock_max_objects",
  358. "-lock_timeout",
  359. "-log",
  360. "-log_buffer",
  361. "-log_max",
  362. "-log_regionmax",
  363. "-mmapsize",
  364. "-nommap",
  365. "-overwrite",
  366. "-region_init",
  367. "-rep_client",
  368. "-rep_logsonly",
  369. "-rep_master",
  370. "-rep_transport",
  371. "-server",
  372. "-server_timeout",
  373. "-txn_timeout",
  374. "-txn_timestamp",
  375. "-verbose",
  376. "-wrnosync",
  377. #endif
  378. "-cachesize",
  379. "-create",
  380. "-data_dir",
  381. "-encryptaes",
  382. "-encryptany",
  383. "-errfile",
  384. "-errpfx",
  385. "-home",
  386. "-log_dir",
  387. "-mode",
  388. "-private",
  389. "-recover",
  390. "-recover_fatal",
  391. "-shm_key",
  392. "-system_mem",
  393. "-tmp_dir",
  394. "-txn",
  395. "-txn_max",
  396. "-use_environ",
  397. "-use_environ_root",
  398. NULL
  399. };
  400. /*
  401.  * !!!
  402.  * These have to be in the same order as the above,
  403.  * which is close to but not quite alphabetical.
  404.  */
  405. enum envopen {
  406. #if CONFIG_TEST
  407. ENV_AUTO_COMMIT,
  408. ENV_CDB,
  409. ENV_CDB_ALLDB,
  410. ENV_CLIENT_TO,
  411. ENV_LOCK,
  412. ENV_CONFLICT,
  413. ENV_DETECT,
  414. ENV_LOCK_MAX,
  415. ENV_LOCK_MAX_LOCKS,
  416. ENV_LOCK_MAX_LOCKERS,
  417. ENV_LOCK_MAX_OBJECTS,
  418. ENV_LOCK_TIMEOUT,
  419. ENV_LOG,
  420. ENV_LOG_BUFFER,
  421. ENV_LOG_MAX,
  422. ENV_LOG_REGIONMAX,
  423. ENV_MMAPSIZE,
  424. ENV_NOMMAP,
  425. ENV_OVERWRITE,
  426. ENV_REGION_INIT,
  427. ENV_REP_CLIENT,
  428. ENV_REP_LOGSONLY,
  429. ENV_REP_MASTER,
  430. ENV_REP_TRANSPORT,
  431. ENV_SERVER,
  432. ENV_SERVER_TO,
  433. ENV_TXN_TIMEOUT,
  434. ENV_TXN_TIME,
  435. ENV_VERBOSE,
  436. ENV_WRNOSYNC,
  437. #endif
  438. ENV_CACHESIZE,
  439. ENV_CREATE,
  440. ENV_DATA_DIR,
  441. ENV_ENCRYPT_AES,
  442. ENV_ENCRYPT_ANY,
  443. ENV_ERRFILE,
  444. ENV_ERRPFX,
  445. ENV_HOME,
  446. ENV_LOG_DIR,
  447. ENV_MODE,
  448. ENV_PRIVATE,
  449. ENV_RECOVER,
  450. ENV_RECOVER_FATAL,
  451. ENV_SHM_KEY,
  452. ENV_SYSTEM_MEM,
  453. ENV_TMP_DIR,
  454. ENV_TXN,
  455. ENV_TXN_MAX,
  456. ENV_USE_ENVIRON,
  457. ENV_USE_ENVIRON_ROOT
  458. };
  459. Tcl_Obj **myobjv, **myobjv1;
  460. time_t timestamp;
  461. u_int32_t detect, gbytes, bytes, ncaches, logbufset, logmaxset;
  462. u_int32_t open_flags, rep_flags, set_flags, size, uintarg;
  463. u_int8_t *conflicts;
  464. int i, intarg, j, mode, myobjc, nmodes, optindex;
  465. int result, ret, temp;
  466. long client_to, server_to, shm;
  467. char *arg, *home, *passwd, *server;
  469. result = TCL_OK;
  470. mode = 0;
  471. rep_flags = set_flags = 0;
  472. home = NULL;
  474. /*
  475.  * XXX
  476.  * If/when our Tcl interface becomes thread-safe, we should enable
  477.  * DB_THREAD here in all cases.  For now, turn it on only when testing
  478.  * so that we exercise MUTEX_THREAD_LOCK cases.
  479.  *
  480.  * Historically, a key stumbling block was the log_get interface,
  481.  * which could only do relative operations in a non-threaded
  482.  * environment.  This is no longer an issue, thanks to log cursors,
  483.  * but we need to look at making sure DBTCL_INFO structs
  484.  * are safe to share across threads (they're not mutex-protected)
  485.  * before we declare the Tcl interface thread-safe.  Meanwhile,
  486.  * there's no strong reason to enable DB_THREAD.
  487.  */
  488. open_flags = DB_JOINENV |
  489. #ifdef TEST_THREAD
  490.     DB_THREAD;
  491. #else
  492.     0;
  493. #endif
  494. logmaxset = logbufset = 0;
  496. if (objc <= 2) {
  497. Tcl_WrongNumArgs(interp, 2, objv, "?args?");
  498. return (TCL_ERROR);
  499. }
  501. /*
  502.  * Server code must go before the call to db_env_create.
  503.  */
  504. server = NULL;
  505. server_to = client_to = 0;
  506. i = 2;
  507. while (i < objc) {
  508. if (Tcl_GetIndexFromObj(interp, objv[i++], envopen, "option",
  509.     TCL_EXACT, &optindex) != TCL_OK) {
  510. Tcl_ResetResult(interp);
  511. continue;
  512. }
  513. switch ((enum envopen)optindex) {
  514. #if CONFIG_TEST
  515. case ENV_SERVER:
  516. if (i >= objc) {
  517. Tcl_WrongNumArgs(interp, 2, objv,
  518.     "?-server hostname");
  519. result = TCL_ERROR;
  520. break;
  521. }
  522. server = Tcl_GetStringFromObj(objv[i++], NULL);
  523. break;
  524. case ENV_SERVER_TO:
  525. if (i >= objc) {
  526. Tcl_WrongNumArgs(interp, 2, objv,
  527.     "?-server_to secs");
  528. result = TCL_ERROR;
  529. break;
  530. }
  531. result = Tcl_GetLongFromObj(interp, objv[i++],
  532.     &server_to);
  533. break;
  534. case ENV_CLIENT_TO:
  535. if (i >= objc) {
  536. Tcl_WrongNumArgs(interp, 2, objv,
  537.     "?-client_to secs");
  538. result = TCL_ERROR;
  539. break;
  540. }
  541. result = Tcl_GetLongFromObj(interp, objv[i++],
  542.     &client_to);
  543. break;
  544. #endif
  545. default:
  546. break;
  547. }
  548. }
  549. if (server != NULL) {
  550. ret = db_env_create(env, DB_CLIENT);
  551. if (ret)
  552. return (_ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  553.     "db_env_create"));
  554. (*env)->set_errpfx((*env), ip->i_name);
  555. (*env)->set_errcall((*env), _ErrorFunc);
  556. if ((ret = (*env)->set_rpc_server((*env), NULL, server,
  557.     client_to, server_to, 0)) != 0) {
  558. result = TCL_ERROR;
  559. goto error;
  560. }
  561. } else {
  562. /*
  563.  * Create the environment handle before parsing the args
  564.  * since we'll be modifying the environment as we parse.
  565.  */
  566. ret = db_env_create(env, 0);
  567. if (ret)
  568. return (_ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  569.     "db_env_create"));
  570. (*env)->set_errpfx((*env), ip->i_name);
  571. (*env)->set_errcall((*env), _ErrorFunc);
  572. }
  574. /* Hang our info pointer on the env handle, so we can do callbacks. */
  575. (*env)->app_private = ip;
  577. /*
  578.  * Use a Tcl-local alloc and free function so that we're sure to
  579.  * test whether we use umalloc/ufree in the right places.
  580.  */
  581. #ifdef TEST_ALLOC
  582. (*env)->set_alloc(*env, tcl_db_malloc, tcl_db_realloc, tcl_db_free);
  583. #endif
  585. /*
  586.  * Get the command name index from the object based on the bdbcmds
  587.  * defined above.
  588.  */
  589. i = 2;
  590. while (i < objc) {
  591. Tcl_ResetResult(interp);
  592. if (Tcl_GetIndexFromObj(interp, objv[i], envopen, "option",
  593.     TCL_EXACT, &optindex) != TCL_OK) {
  594. result = IS_HELP(objv[i]);
  595. goto error;
  596. }
  597. i++;
  598. switch ((enum envopen)optindex) {
  599. #if CONFIG_TEST
  600. case ENV_SERVER:
  601. case ENV_SERVER_TO:
  602. case ENV_CLIENT_TO:
  603. /*
  604.  * Already handled these, skip them and their arg.
  605.  */
  606. i++;
  607. break;
  608. case ENV_AUTO_COMMIT:
  609. FLD_SET(set_flags, DB_AUTO_COMMIT);
  610. break;
  611. case ENV_CDB:
  612. FLD_SET(open_flags, DB_INIT_CDB | DB_INIT_MPOOL);
  613. FLD_CLR(open_flags, DB_JOINENV);
  614. break;
  615. case ENV_CDB_ALLDB:
  616. FLD_SET(set_flags, DB_CDB_ALLDB);
  617. break;
  618. case ENV_LOCK:
  619. FLD_SET(open_flags, DB_INIT_LOCK | DB_INIT_MPOOL);
  620. FLD_CLR(open_flags, DB_JOINENV);
  621. break;
  622. case ENV_CONFLICT:
  623. /*
  624.  * Get conflict list.  List is:
  625.  * {nmodes {matrix}}
  626.  *
  627.  * Where matrix must be nmodes*nmodes big.
  628.  * Set up conflicts array to pass.
  629.  */
  630. result = Tcl_ListObjGetElements(interp, objv[i],
  631.     &myobjc, &myobjv);
  632. if (result == TCL_OK)
  633. i++;
  634. else
  635. break;
  636. if (myobjc != 2) {
  637. Tcl_WrongNumArgs(interp, 2, objv,
  638.     "?-lock_conflict {nmodes {matrix}}?");
  639. result = TCL_ERROR;
  640. break;
  641. }
  642. result = Tcl_GetIntFromObj(interp, myobjv[0], &nmodes);
  643. if (result != TCL_OK)
  644. break;
  645. result = Tcl_ListObjGetElements(interp, myobjv[1],
  646.     &myobjc, &myobjv1);
  647. if (myobjc != (nmodes * nmodes)) {
  648. Tcl_WrongNumArgs(interp, 2, objv,
  649.     "?-lock_conflict {nmodes {matrix}}?");
  650. result = TCL_ERROR;
  651. break;
  652. }
  653. size = sizeof(u_int8_t) * nmodes*nmodes;
  654. ret = __os_malloc(*env, size, &conflicts);
  655. if (ret != 0) {
  656. result = TCL_ERROR;
  657. break;
  658. }
  659. for (j = 0; j < myobjc; j++) {
  660. result = Tcl_GetIntFromObj(interp, myobjv1[j],
  661.     &temp);
  662. conflicts[j] = temp;
  663. if (result != TCL_OK) {
  664. __os_free(NULL, conflicts);
  665. break;
  666. }
  667. }
  668. _debug_check();
  669. ret = (*env)->set_lk_conflicts(*env,
  670.     (u_int8_t *)conflicts, nmodes);
  671. __os_free(NULL, conflicts);
  672. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  673.     "set_lk_conflicts");
  674. break;
  675. case ENV_DETECT:
  676. if (i >= objc) {
  677. Tcl_WrongNumArgs(interp, 2, objv,
  678.     "?-lock_detect policy?");
  679. result = TCL_ERROR;
  680. break;
  681. }
  682. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  683. if (strcmp(arg, "default") == 0)
  684. detect = DB_LOCK_DEFAULT;
  685. else if (strcmp(arg, "expire") == 0)
  686. detect = DB_LOCK_EXPIRE;
  687. else if (strcmp(arg, "maxlocks") == 0)
  688. detect = DB_LOCK_MAXLOCKS;
  689. else if (strcmp(arg, "minlocks") == 0)
  690. detect = DB_LOCK_MINLOCKS;
  691. else if (strcmp(arg, "minwrites") == 0)
  692. detect = DB_LOCK_MINWRITE;
  693. else if (strcmp(arg, "oldest") == 0)
  694. detect = DB_LOCK_OLDEST;
  695. else if (strcmp(arg, "youngest") == 0)
  696. detect = DB_LOCK_YOUNGEST;
  697. else if (strcmp(arg, "random") == 0)
  698. detect = DB_LOCK_RANDOM;
  699. else {
  700. Tcl_AddErrorInfo(interp,
  701.     "lock_detect: illegal policy");
  702. result = TCL_ERROR;
  703. break;
  704. }
  705. _debug_check();
  706. ret = (*env)->set_lk_detect(*env, detect);
  707. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  708.     "lock_detect");
  709. break;
  710. case ENV_LOCK_MAX:
  711. case ENV_LOCK_MAX_LOCKS:
  712. case ENV_LOCK_MAX_LOCKERS:
  713. case ENV_LOCK_MAX_OBJECTS:
  714. if (i >= objc) {
  715. Tcl_WrongNumArgs(interp, 2, objv,
  716.     "?-lock_max max?");
  717. result = TCL_ERROR;
  718. break;
  719. }
  720. result = _GetUInt32(interp, objv[i++], &uintarg);
  721. if (result == TCL_OK) {
  722. _debug_check();
  723. switch ((enum envopen)optindex) {
  724. case ENV_LOCK_MAX:
  725. ret = (*env)->set_lk_max(*env,
  726.     uintarg);
  727. break;
  728. case ENV_LOCK_MAX_LOCKS:
  729. ret = (*env)->set_lk_max_locks(*env,
  730.     uintarg);
  731. break;
  732. case ENV_LOCK_MAX_LOCKERS:
  733. ret = (*env)->set_lk_max_lockers(*env,
  734.     uintarg);
  735. break;
  736. case ENV_LOCK_MAX_OBJECTS:
  737. ret = (*env)->set_lk_max_objects(*env,
  738.     uintarg);
  739. break;
  740. default:
  741. break;
  742. }
  743. result = _ReturnSetup(interp, ret,
  744.     DB_RETOK_STD(ret), "lock_max");
  745. }
  746. break;
  747. case ENV_TXN_TIME:
  748. case ENV_TXN_TIMEOUT:
  749. case ENV_LOCK_TIMEOUT:
  750. if (i >= objc) {
  751. Tcl_WrongNumArgs(interp, 2, objv,
  752.     "?-txn_timestamp time?");
  753. result = TCL_ERROR;
  754. break;
  755. }
  756. result = Tcl_GetLongFromObj(interp, objv[i++],
  757.     (long *)&timestamp);
  758. if (result == TCL_OK) {
  759. _debug_check();
  760. if (optindex == ENV_TXN_TIME)
  761. ret = (*env)->
  762.     set_tx_timestamp(*env, &timestamp);
  763. else
  764. ret = (*env)->set_timeout(*env,
  765.     (db_timeout_t)timestamp,
  766.     optindex == ENV_TXN_TIMEOUT ?
  767.     DB_SET_TXN_TIMEOUT :
  768.     DB_SET_LOCK_TIMEOUT);
  769. result = _ReturnSetup(interp, ret,
  770.     DB_RETOK_STD(ret), "txn_timestamp");
  771. }
  772. break;
  773. case ENV_LOG:
  774. FLD_SET(open_flags, DB_INIT_LOG | DB_INIT_MPOOL);
  775. FLD_CLR(open_flags, DB_JOINENV);
  776. break;
  777. case ENV_LOG_BUFFER:
  778. if (i >= objc) {
  779. Tcl_WrongNumArgs(interp, 2, objv,
  780.     "?-log_buffer size?");
  781. result = TCL_ERROR;
  782. break;
  783. }
  784. result = _GetUInt32(interp, objv[i++], &uintarg);
  785. if (result == TCL_OK) {
  786. _debug_check();
  787. ret = (*env)->set_lg_bsize(*env, uintarg);
  788. result = _ReturnSetup(interp, ret,
  789.     DB_RETOK_STD(ret), "log_bsize");
  790. logbufset = 1;
  791. if (logmaxset) {
  792. _debug_check();
  793. ret = (*env)->set_lg_max(*env,
  794.     logmaxset);
  795. result = _ReturnSetup(interp, ret,
  796.     DB_RETOK_STD(ret), "log_max");
  797. logmaxset = 0;
  798. logbufset = 0;
  799. }
  800. }
  801. break;
  802. case ENV_LOG_MAX:
  803. if (i >= objc) {
  804. Tcl_WrongNumArgs(interp, 2, objv,
  805.     "?-log_max max?");
  806. result = TCL_ERROR;
  807. break;
  808. }
  809. result = _GetUInt32(interp, objv[i++], &uintarg);
  810. if (result == TCL_OK && logbufset) {
  811. _debug_check();
  812. ret = (*env)->set_lg_max(*env, uintarg);
  813. result = _ReturnSetup(interp, ret,
  814.     DB_RETOK_STD(ret), "log_max");
  815. logbufset = 0;
  816. } else
  817. logmaxset = uintarg;
  818. break;
  819. case ENV_LOG_REGIONMAX:
  820. if (i >= objc) {
  821. Tcl_WrongNumArgs(interp, 2, objv,
  822.     "?-log_regionmax size?");
  823. result = TCL_ERROR;
  824. break;
  825. }
  826. result = _GetUInt32(interp, objv[i++], &uintarg);
  827. if (result == TCL_OK) {
  828. _debug_check();
  829. ret = (*env)->set_lg_regionmax(*env, uintarg);
  830. result =
  831.     _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  832. "log_regionmax");
  833. }
  834. break;
  835. case ENV_MMAPSIZE:
  836. if (i >= objc) {
  837. Tcl_WrongNumArgs(interp, 2, objv,
  838.     "?-mmapsize size?");
  839. result = TCL_ERROR;
  840. break;
  841. }
  842. result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
  843. if (result == TCL_OK) {
  844. _debug_check();
  845. ret = (*env)->set_mp_mmapsize(*env,
  846.     (size_t)intarg);
  847. result = _ReturnSetup(interp, ret,
  848.     DB_RETOK_STD(ret), "mmapsize");
  849. }
  850. break;
  851. case ENV_NOMMAP:
  852. FLD_SET(set_flags, DB_NOMMAP);
  853. break;
  854. case ENV_OVERWRITE:
  855. FLD_SET(set_flags, DB_OVERWRITE);
  856. break;
  857. case ENV_REGION_INIT:
  858. _debug_check();
  859. ret = (*env)->set_flags(*env, DB_REGION_INIT, 1);
  860. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  861.     "region_init");
  862. break;
  863. case ENV_REP_CLIENT:
  864. rep_flags = DB_REP_CLIENT;
  865. break;
  866. case ENV_REP_LOGSONLY:
  867. rep_flags = DB_REP_LOGSONLY;
  868. break;
  869. case ENV_REP_MASTER:
  870. rep_flags = DB_REP_MASTER;
  871. break;
  872. case ENV_REP_TRANSPORT:
  873. if (i >= objc) {
  874. Tcl_WrongNumArgs(interp, 2, objv,
  875.     "-rep_transport {envid sendproc}");
  876. result = TCL_ERROR;
  877. break;
  878. }
  880. /*
  881.  * Store the objects containing the machine ID
  882.  * and the procedure name.  We don't need to crack
  883.  * the send procedure out now, but we do convert the
  884.  * machine ID to an int, since set_rep_transport needs
  885.  * it.  Even so, it'll be easier later to deal with
  886.  * the Tcl_Obj *, so we save that, not the int.
  887.  *
  888.  * Note that we Tcl_IncrRefCount both objects
  889.  * independently;  Tcl is free to discard the list
  890.  * that they're bundled into.
  891.  */
  892. result = Tcl_ListObjGetElements(interp, objv[i++],
  893.     &myobjc, &myobjv);
  894. if (myobjc != 2) {
  895. Tcl_SetResult(interp,
  896.     "List must be {envid sendproc}",
  897.     TCL_STATIC);
  898. result = TCL_ERROR;
  899. break;
  900. }
  902. /*
  903.  * Check that the machine ID is an int.  Note that
  904.  * we do want to use GetIntFromObj;  the machine
  905.  * ID is explicitly an int, not a u_int32_t.
  906.  */
  907. ip->i_rep_eid = myobjv[0];
  908. Tcl_IncrRefCount(ip->i_rep_eid);
  909. result = Tcl_GetIntFromObj(interp,
  910.     ip->i_rep_eid, &intarg);
  911. if (result != TCL_OK)
  912. break;
  914. ip->i_rep_send = myobjv[1];
  915. Tcl_IncrRefCount(ip->i_rep_send);
  916. _debug_check();
  917. ret = (*env)->set_rep_transport(*env,
  918.     intarg, tcl_rep_send);
  919. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  920.     "set_rep_transport");
  921. break;
  922. case ENV_VERBOSE:
  923. result = Tcl_ListObjGetElements(interp, objv[i],
  924.     &myobjc, &myobjv);
  925. if (result == TCL_OK)
  926. i++;
  927. else
  928. break;
  929. if (myobjc != 2) {
  930. Tcl_WrongNumArgs(interp, 2, objv,
  931.     "?-verbose {which on|off}?");
  932. result = TCL_ERROR;
  933. break;
  934. }
  935. result = tcl_EnvVerbose(interp, *env,
  936.     myobjv[0], myobjv[1]);
  937. break;
  938. case ENV_WRNOSYNC:
  939. FLD_SET(set_flags, DB_TXN_WRITE_NOSYNC);
  940. break;
  941. #endif
  942. case ENV_TXN:
  943. FLD_SET(open_flags, DB_INIT_LOCK |
  944.     DB_INIT_LOG | DB_INIT_MPOOL | DB_INIT_TXN);
  945. FLD_CLR(open_flags, DB_JOINENV);
  946. /* Make sure we have an arg to check against! */
  947. if (i < objc) {
  948. arg = Tcl_GetStringFromObj(objv[i], NULL);
  949. if (strcmp(arg, "nosync") == 0) {
  950. FLD_SET(set_flags, DB_TXN_NOSYNC);
  951. i++;
  952. }
  953. }
  954. break;
  955. case ENV_CREATE:
  956. FLD_SET(open_flags, DB_CREATE | DB_INIT_MPOOL);
  957. FLD_CLR(open_flags, DB_JOINENV);
  958. break;
  959. case ENV_ENCRYPT_AES:
  960. /* Make sure we have an arg to check against! */
  961. if (i >= objc) {
  962. Tcl_WrongNumArgs(interp, 2, objv,
  963.     "?-encryptaes passwd?");
  964. result = TCL_ERROR;
  965. break;
  966. }
  967. passwd = Tcl_GetStringFromObj(objv[i++], NULL);
  968. _debug_check();
  969. ret = (*env)->set_encrypt(*env, passwd, DB_ENCRYPT_AES);
  970. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  971.     "set_encrypt");
  972. break;
  973. case ENV_ENCRYPT_ANY:
  974. /* Make sure we have an arg to check against! */
  975. if (i >= objc) {
  976. Tcl_WrongNumArgs(interp, 2, objv,
  977.     "?-encryptany passwd?");
  978. result = TCL_ERROR;
  979. break;
  980. }
  981. passwd = Tcl_GetStringFromObj(objv[i++], NULL);
  982. _debug_check();
  983. ret = (*env)->set_encrypt(*env, passwd, 0);
  984. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  985.     "set_encrypt");
  986. break;
  987. case ENV_HOME:
  988. /* Make sure we have an arg to check against! */
  989. if (i >= objc) {
  990. Tcl_WrongNumArgs(interp, 2, objv,
  991.     "?-home dir?");
  992. result = TCL_ERROR;
  993. break;
  994. }
  995. home = Tcl_GetStringFromObj(objv[i++], NULL);
  996. break;
  997. case ENV_MODE:
  998. if (i >= objc) {
  999. Tcl_WrongNumArgs(interp, 2, objv,
  1000.     "?-mode mode?");
  1001. result = TCL_ERROR;
  1002. break;
  1003. }
  1004. /*
  1005.  * Don't need to check result here because
  1006.  * if TCL_ERROR, the error message is already
  1007.  * set up, and we'll bail out below.  If ok,
  1008.  * the mode is set and we go on.
  1009.  */
  1010. result = Tcl_GetIntFromObj(interp, objv[i++], &mode);
  1011. break;
  1012. case ENV_PRIVATE:
  1013. FLD_SET(open_flags, DB_PRIVATE | DB_INIT_MPOOL);
  1014. FLD_CLR(open_flags, DB_JOINENV);
  1015. break;
  1016. case ENV_RECOVER:
  1017. FLD_SET(open_flags, DB_RECOVER);
  1018. break;
  1019. case ENV_RECOVER_FATAL:
  1020. FLD_SET(open_flags, DB_RECOVER_FATAL);
  1021. break;
  1022. case ENV_SYSTEM_MEM:
  1023. FLD_SET(open_flags, DB_SYSTEM_MEM);
  1024. break;
  1025. case ENV_USE_ENVIRON_ROOT:
  1026. FLD_SET(open_flags, DB_USE_ENVIRON_ROOT);
  1027. break;
  1028. case ENV_USE_ENVIRON:
  1029. FLD_SET(open_flags, DB_USE_ENVIRON);
  1030. break;
  1031. case ENV_CACHESIZE:
  1032. result = Tcl_ListObjGetElements(interp, objv[i],
  1033.     &myobjc, &myobjv);
  1034. if (result == TCL_OK)
  1035. i++;
  1036. else
  1037. break;
  1038. if (myobjc != 3) {
  1039. Tcl_WrongNumArgs(interp, 2, objv,
  1040.     "?-cachesize {gbytes bytes ncaches}?");
  1041. result = TCL_ERROR;
  1042. break;
  1043. }
  1044. result = _GetUInt32(interp, myobjv[0], &gbytes);
  1045. if (result != TCL_OK)
  1046. break;
  1047. result = _GetUInt32(interp, myobjv[1], &bytes);
  1048. if (result != TCL_OK)
  1049. break;
  1050. result = _GetUInt32(interp, myobjv[2], &ncaches);
  1051. if (result != TCL_OK)
  1052. break;
  1053. _debug_check();
  1054. ret = (*env)->set_cachesize(*env, gbytes, bytes,
  1055.     ncaches);
  1056. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  1057.     "set_cachesize");
  1058. break;
  1059. case ENV_SHM_KEY:
  1060. if (i >= objc) {
  1061. Tcl_WrongNumArgs(interp, 2, objv,
  1062.     "?-shm_key key?");
  1063. result = TCL_ERROR;
  1064. break;
  1065. }
  1066. result = Tcl_GetLongFromObj(interp, objv[i++], &shm);
  1067. if (result == TCL_OK) {
  1068. _debug_check();
  1069. ret = (*env)->set_shm_key(*env, shm);
  1070. result = _ReturnSetup(interp, ret,
  1071.     DB_RETOK_STD(ret), "shm_key");
  1072. }
  1073. break;
  1074. case ENV_TXN_MAX:
  1075. if (i >= objc) {
  1076. Tcl_WrongNumArgs(interp, 2, objv,
  1077.     "?-txn_max max?");
  1078. result = TCL_ERROR;
  1079. break;
  1080. }
  1081. result = _GetUInt32(interp, objv[i++], &uintarg);
  1082. if (result == TCL_OK) {
  1083. _debug_check();
  1084. ret = (*env)->set_tx_max(*env, uintarg);
  1085. result = _ReturnSetup(interp, ret,
  1086.     DB_RETOK_STD(ret), "txn_max");
  1087. }
  1088. break;
  1089. case ENV_ERRFILE:
  1090. if (i >= objc) {
  1091. Tcl_WrongNumArgs(interp, 2, objv,
  1092.     "-errfile file");
  1093. result = TCL_ERROR;
  1094. break;
  1095. }
  1096. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  1097. /*
  1098.  * If the user already set one, close it.
  1099.  */
  1100. if (ip->i_err != NULL)
  1101. fclose(ip->i_err);
  1102. ip->i_err = fopen(arg, "a");
  1103. if (ip->i_err != NULL) {
  1104. _debug_check();
  1105. (*env)->set_errfile(*env, ip->i_err);
  1106. }
  1107. break;
  1108. case ENV_ERRPFX:
  1109. if (i >= objc) {
  1110. Tcl_WrongNumArgs(interp, 2, objv,
  1111.     "-errpfx prefix");
  1112. result = TCL_ERROR;
  1113. break;
  1114. }
  1115. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  1116. /*
  1117.  * If the user already set one, free it.
  1118.  */
  1119. if (ip->i_errpfx != NULL)
  1120. __os_free(NULL, ip->i_errpfx);
  1121. if ((ret =
  1122.     __os_strdup(*env, arg, &ip->i_errpfx)) != 0) {
  1123. result = _ReturnSetup(interp, ret,
  1124.     DB_RETOK_STD(ret), "__os_strdup");
  1125. break;
  1126. }
  1127. if (ip->i_errpfx != NULL) {
  1128. _debug_check();
  1129. (*env)->set_errpfx(*env, ip->i_errpfx);
  1130. }
  1131. break;
  1132. case ENV_DATA_DIR:
  1133. if (i >= objc) {
  1134. Tcl_WrongNumArgs(interp, 2, objv,
  1135.     "-data_dir dir");
  1136. result = TCL_ERROR;
  1137. break;
  1138. }
  1139. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  1140. _debug_check();
  1141. ret = (*env)->set_data_dir(*env, arg);
  1142. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  1143.     "set_data_dir");
  1144. break;
  1145. case ENV_LOG_DIR:
  1146. if (i >= objc) {
  1147. Tcl_WrongNumArgs(interp, 2, objv,
  1148.     "-log_dir dir");
  1149. result = TCL_ERROR;
  1150. break;
  1151. }
  1152. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  1153. _debug_check();
  1154. ret = (*env)->set_lg_dir(*env, arg);
  1155. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  1156.     "set_lg_dir");
  1157. break;
  1158. case ENV_TMP_DIR:
  1159. if (i >= objc) {
  1160. Tcl_WrongNumArgs(interp, 2, objv,
  1161.     "-tmp_dir dir");
  1162. result = TCL_ERROR;
  1163. break;
  1164. }
  1165. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  1166. _debug_check();
  1167. ret = (*env)->set_tmp_dir(*env, arg);
  1168. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  1169.     "set_tmp_dir");
  1170. break;
  1171. }
  1172. /*
  1173.  * If, at any time, parsing the args we get an error,
  1174.  * bail out and return.
  1175.  */
  1176. if (result != TCL_OK)
  1177. goto error;
  1178. }
  1180. /*
  1181.  * We have to check this here.  We want to set the log buffer
  1182.  * size first, if it is specified.  So if the user did so,
  1183.  * then we took care of it above.  But, if we get out here and
  1184.  * logmaxset is non-zero, then they set the log_max without
  1185.  * resetting the log buffer size, so we now have to do the
  1186.  * call to set_lg_max, since we didn't do it above.
  1187.  */
  1188. if (logmaxset) {
  1189. _debug_check();
  1190. ret = (*env)->set_lg_max(*env, (u_int32_t)logmaxset);
  1191. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  1192.     "log_max");
  1193. }
  1195. if (result != TCL_OK)
  1196. goto error;
  1198. if (set_flags) {
  1199. ret = (*env)->set_flags(*env, set_flags, 1);
  1200. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  1201.     "set_flags");
  1202. if (result == TCL_ERROR)
  1203. goto error;
  1204. /*
  1205.  * If we are successful, clear the result so that the
  1206.  * return from set_flags isn't part of the result.
  1207.  */
  1208. Tcl_ResetResult(interp);
  1209. }
  1210. /*
  1211.  * When we get here, we have already parsed all of our args
  1212.  * and made all our calls to set up the environment.  Everything
  1213.  * is okay so far, no errors, if we get here.
  1214.  *
  1215.  * Now open the environment.
  1216.  */
  1217. _debug_check();
  1218. ret = (*env)->open(*env, home, open_flags, mode);
  1219. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "env open");
  1221. if (rep_flags != 0 && result == TCL_OK) {
  1222. _debug_check();
  1223. ret = (*env)->rep_start(*env, NULL, rep_flags);
  1224. result = _ReturnSetup(interp,
  1225.     ret, DB_RETOK_STD(ret), "rep_start");
  1226. }
  1228. error: if (result == TCL_ERROR) {
  1229. if (ip->i_err) {
  1230. fclose(ip->i_err);
  1231. ip->i_err = NULL;
  1232. }
  1233. (void)(*env)->close(*env, 0);
  1234. *env = NULL;
  1235. }
  1236. return (result);
  1237. }
  1239. /*
  1240.  * bdb_DbOpen --
  1241.  * Implements the "db_create/db_open" command.
  1242.  * There are many, many options to the open command.
  1243.  * Here is the general flow:
  1244.  *
  1245.  * 0.  Preparse args to determine if we have -env.
  1246.  * 1.  Call db_create to create the db handle.
  1247.  * 2.  Parse args tracking options.
  1248.  * 3.  Make any pre-open setup calls necessary.
  1249.  * 4.  Call DB->open to open the database.
  1250.  * 5.  Return db widget handle to user.
  1251.  */
  1252. static int
  1253. bdb_DbOpen(interp, objc, objv, ip, dbp)
  1254. Tcl_Interp *interp; /* Interpreter */
  1255. int objc; /* How many arguments? */
  1256. Tcl_Obj *CONST objv[]; /* The argument objects */
  1257. DBTCL_INFO *ip; /* Our internal info */
  1258. DB **dbp; /* DB handle */
  1259. {
  1260. static char *bdbenvopen[] = {
  1261. "-env", NULL
  1262. };
  1263. enum bdbenvopen {
  1264. TCL_DB_ENV0
  1265. };
  1266. static char *bdbopen[] = {
  1267. #if CONFIG_TEST
  1268. "-btcompare",
  1269. "-dirty",
  1270. "-dupcompare",
  1271. "-hashproc",
  1272. "-lorder",
  1273. "-minkey",
  1274. "-nommap",
  1275. "-revsplitoff",
  1276. "-test",
  1277. #endif
  1278. "-auto_commit",
  1279. "-btree",
  1280. "-cachesize",
  1281. "-chksum",
  1282. "-create",
  1283. "-delim",
  1284. "-dup",
  1285. "-dupsort",
  1286. "-encrypt",
  1287. "-encryptaes",
  1288. "-encryptany",
  1289. "-env",
  1290. "-errfile",
  1291. "-errpfx",
  1292. "-excl",
  1293. "-extent",
  1294. "-ffactor",
  1295. "-hash",
  1296. "-len",
  1297. "-mode",
  1298. "-nelem",
  1299. "-pad",
  1300. "-pagesize",
  1301. "-queue",
  1302. "-rdonly",
  1303. "-recno",
  1304. "-recnum",
  1305. "-renumber",
  1306. "-snapshot",
  1307. "-source",
  1308. "-truncate",
  1309. "-txn",
  1310. "-unknown",
  1311. "--",
  1312. NULL
  1313. };
  1314. enum bdbopen {
  1315. #if CONFIG_TEST
  1316. TCL_DB_BTCOMPARE,
  1317. TCL_DB_DIRTY,
  1318. TCL_DB_DUPCOMPARE,
  1319. TCL_DB_HASHPROC,
  1320. TCL_DB_LORDER,
  1321. TCL_DB_MINKEY,
  1322. TCL_DB_NOMMAP,
  1323. TCL_DB_REVSPLIT,
  1324. TCL_DB_TEST,
  1325. #endif
  1326. TCL_DB_AUTO_COMMIT,
  1327. TCL_DB_BTREE,
  1328. TCL_DB_CACHESIZE,
  1329. TCL_DB_CHKSUM,
  1330. TCL_DB_CREATE,
  1331. TCL_DB_DELIM,
  1332. TCL_DB_DUP,
  1333. TCL_DB_DUPSORT,
  1334. TCL_DB_ENCRYPT,
  1335. TCL_DB_ENCRYPT_AES,
  1336. TCL_DB_ENCRYPT_ANY,
  1337. TCL_DB_ENV,
  1338. TCL_DB_ERRFILE,
  1339. TCL_DB_ERRPFX,
  1340. TCL_DB_EXCL,
  1341. TCL_DB_EXTENT,
  1342. TCL_DB_FFACTOR,
  1343. TCL_DB_HASH,
  1344. TCL_DB_LEN,
  1345. TCL_DB_MODE,
  1346. TCL_DB_NELEM,
  1347. TCL_DB_PAD,
  1348. TCL_DB_PAGESIZE,
  1349. TCL_DB_QUEUE,
  1350. TCL_DB_RDONLY,
  1351. TCL_DB_RECNO,
  1352. TCL_DB_RECNUM,
  1353. TCL_DB_RENUMBER,
  1354. TCL_DB_SNAPSHOT,
  1355. TCL_DB_SOURCE,
  1356. TCL_DB_TRUNCATE,
  1357. TCL_DB_TXN,
  1358. TCL_DB_UNKNOWN,
  1359. TCL_DB_ENDARG
  1360. };
  1362. DBTCL_INFO *envip, *errip;
  1363. DB_TXN *txn;
  1364. DBTYPE type;
  1365. DB_ENV *envp;
  1366. Tcl_Obj **myobjv;
  1367. u_int32_t gbytes, bytes, ncaches, open_flags, uintarg;
  1368. int endarg, i, intarg, mode, myobjc;
  1369. int optindex, result, ret, set_err, set_flags, set_pfx, subdblen;
  1370. u_char *subdbtmp;
  1371. char *arg, *db, *passwd, *subdb, msg[MSG_SIZE];
  1373. type = DB_UNKNOWN;
  1374. endarg = mode = set_err = set_flags = set_pfx = 0;
  1375. result = TCL_OK;
  1376. subdbtmp = NULL;
  1377. db = subdb = NULL;
  1379. /*
  1380.  * XXX
  1381.  * If/when our Tcl interface becomes thread-safe, we should enable
  1382.  * DB_THREAD here in all cases.  See comment in bdb_EnvOpen().
  1383.  * For now, just turn it on when testing so that we exercise
  1384.  * MUTEX_THREAD_LOCK cases.
  1385.  */
  1386. open_flags =
  1387. #ifdef TEST_THREAD
  1388.     DB_THREAD;
  1389. #else
  1390.     0;
  1391. #endif
  1392. envp = NULL;
  1393. txn = NULL;
  1395. if (objc < 2) {
  1396. Tcl_WrongNumArgs(interp, 2, objv, "?args?");
  1397. return (TCL_ERROR);
  1398. }
  1400. /*
  1401.  * We must first parse for the environment flag, since that
  1402.  * is needed for db_create.  Then create the db handle.
  1403.  */
  1404. i = 2;
  1405. while (i < objc) {
  1406. if (Tcl_GetIndexFromObj(interp, objv[i++], bdbenvopen,
  1407.     "option", TCL_EXACT, &optindex) != TCL_OK) {
  1408. /*
  1409.  * Reset the result so we don't get
  1410.  * an errant error message if there is another error.
  1411.  */
  1412. Tcl_ResetResult(interp);
  1413. continue;
  1414. }
  1415. switch ((enum bdbenvopen)optindex) {
  1416. case TCL_DB_ENV0:
  1417. arg = Tcl_GetStringFromObj(objv[i], NULL);
  1418. envp = NAME_TO_ENV(arg);
  1419. if (envp == NULL) {
  1420. Tcl_SetResult(interp,
  1421.     "db open: illegal environment", TCL_STATIC);
  1422. return (TCL_ERROR);
  1423. }
  1424. }
  1425. break;
  1426. }
  1428. /*
  1429.  * Create the db handle before parsing the args
  1430.  * since we'll be modifying the database options as we parse.
  1431.  */
  1432. ret = db_create(dbp, envp, 0);
  1433. if (ret)
  1434. return (_ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  1435.     "db_create"));
  1437. /* Hang our info pointer on the DB handle, so we can do callbacks. */
  1438. (*dbp)->api_internal = ip;
  1440. /*
  1441.  * XXX Remove restriction when err stuff is not tied to env.
  1442.  *
  1443.  * The DB->set_err* functions actually overwrite in the
  1444.  * environment.  So, if we are explicitly using an env,
  1445.  * don't overwrite what we have already set up.  If we are
  1446.  * not using one, then we set up since we get a private
  1447.  * default env.
  1448.  */
  1449. /* XXX  - remove this conditional if/when err is not tied to env */
  1450. if (envp == NULL) {
  1451. (*dbp)->set_errpfx((*dbp), ip->i_name);
  1452. (*dbp)->set_errcall((*dbp), _ErrorFunc);
  1453. }
  1454. envip = _PtrToInfo(envp); /* XXX */
  1455. /*
  1456.  * If we are using an env, we keep track of err info in the env's ip.
  1457.  * Otherwise use the DB's ip.
  1458.  */
  1459. if (envip)
  1460. errip = envip;
  1461. else
  1462. errip = ip;
  1463. /*
  1464.  * Get the option name index from the object based on the args
  1465.  * defined above.
  1466.  */
  1467. i = 2;
  1468. while (i < objc) {
  1469. Tcl_ResetResult(interp);
  1470. if (Tcl_GetIndexFromObj(interp, objv[i], bdbopen, "option",
  1471.     TCL_EXACT, &optindex) != TCL_OK) {
  1472. arg = Tcl_GetStringFromObj(objv[i], NULL);
  1473. if (arg[0] == '-') {
  1474. result = IS_HELP(objv[i]);
  1475. goto error;
  1476. } else
  1477. Tcl_ResetResult(interp);
  1478. break;
  1479. }
  1480. i++;
  1481. switch ((enum bdbopen)optindex) {
  1482. #if CONFIG_TEST
  1483. case TCL_DB_BTCOMPARE:
  1484. if (i >= objc) {
  1485. Tcl_WrongNumArgs(interp, 2, objv,
  1486.     "-btcompare compareproc");
  1487. result = TCL_ERROR;
  1488. break;
  1489. }
  1491. /*
  1492.  * Store the object containing the procedure name.
  1493.  * We don't need to crack it out now--we'll want
  1494.  * to bundle it up to pass into Tcl_EvalObjv anyway.
  1495.  * Tcl's object refcounting will--I hope--take care
  1496.  * of the memory management here.
  1497.  */
  1498. ip->i_btcompare = objv[i++];
  1499. Tcl_IncrRefCount(ip->i_btcompare);
  1500. _debug_check();
  1501. ret = (*dbp)->set_bt_compare(*dbp, tcl_bt_compare);
  1502. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  1503.     "set_bt_compare");
  1504. break;
  1505. case TCL_DB_DIRTY:
  1506. open_flags |= DB_DIRTY_READ;
  1507. break;
  1508. case TCL_DB_DUPCOMPARE:
  1509. if (i >= objc) {
  1510. Tcl_WrongNumArgs(interp, 2, objv,
  1511.     "-dupcompare compareproc");
  1512. result = TCL_ERROR;
  1513. break;
  1514. }
  1516. /*
  1517.  * Store the object containing the procedure name.
  1518.  * See TCL_DB_BTCOMPARE.
  1519.  */
  1520. ip->i_dupcompare = objv[i++];
  1521. Tcl_IncrRefCount(ip->i_dupcompare);
  1522. _debug_check();
  1523. ret = (*dbp)->set_dup_compare(*dbp, tcl_dup_compare);
  1524. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  1525.     "set_dup_compare");
  1526. break;
  1527. case TCL_DB_HASHPROC:
  1528. if (i >= objc) {
  1529. Tcl_WrongNumArgs(interp, 2, objv,
  1530.     "-hashproc hashproc");
  1531. result = TCL_ERROR;
  1532. break;
  1533. }
  1535. /*
  1536.  * Store the object containing the procedure name.
  1537.  * See TCL_DB_BTCOMPARE.
  1538.  */
  1539. ip->i_hashproc = objv[i++];
  1540. Tcl_IncrRefCount(ip->i_hashproc);
  1541. _debug_check();
  1542. ret = (*dbp)->set_h_hash(*dbp, tcl_h_hash);
  1543. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  1544.     "set_h_hash");
  1545. break;
  1546. case TCL_DB_LORDER:
  1547. if (i >= objc) {
  1548. Tcl_WrongNumArgs(interp, 2, objv,
  1549.     "-lorder 1234|4321");
  1550. result = TCL_ERROR;
  1551. break;
  1552. }
  1553. result = _GetUInt32(interp, objv[i++], &uintarg);
  1554. if (result == TCL_OK) {
  1555. _debug_check();
  1556. ret = (*dbp)->set_lorder(*dbp, uintarg);
  1557. result = _ReturnSetup(interp, ret,
  1558.     DB_RETOK_STD(ret), "set_lorder");
  1559. }
  1560. break;
  1561. case TCL_DB_MINKEY:
  1562. if (i >= objc) {
  1563. Tcl_WrongNumArgs(interp, 2, objv,
  1564.     "-minkey minkey");
  1565. result = TCL_ERROR;
  1566. break;
  1567. }
  1568. result = _GetUInt32(interp, objv[i++], &uintarg);
  1569. if (result == TCL_OK) {
  1570. _debug_check();
  1571. ret = (*dbp)->set_bt_minkey(*dbp, uintarg);
  1572. result = _ReturnSetup(interp, ret,
  1573.     DB_RETOK_STD(ret), "set_bt_minkey");
  1574. }
  1575. break;
  1576. case TCL_DB_NOMMAP:
  1577. open_flags |= DB_NOMMAP;
  1578. break;
  1579. case TCL_DB_REVSPLIT:
  1580. set_flags |= DB_REVSPLITOFF;
  1581. break;
  1582. case TCL_DB_TEST:
  1583. (*dbp)->set_h_hash(*dbp, __ham_test);
  1584. break;
  1585. #endif
  1586. case TCL_DB_AUTO_COMMIT:
  1587. open_flags |= DB_AUTO_COMMIT;
  1588. break;
  1589. case TCL_DB_ENV:
  1590. /*
  1591.  * Already parsed this, skip it and the env pointer.
  1592.  */
  1593. i++;
  1594. continue;
  1595. case TCL_DB_TXN:
  1596. if (i > (objc - 1)) {
  1597. Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?");
  1598. result = TCL_ERROR;
  1599. break;
  1600. }
  1601. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  1602. txn = NAME_TO_TXN(arg);
  1603. if (txn == NULL) {
  1604. snprintf(msg, MSG_SIZE,
  1605.     "Put: Invalid txn: %sn", arg);
  1606. Tcl_SetResult(interp, msg, TCL_VOLATILE);
  1607. result = TCL_ERROR;
  1608. }
  1609. break;
  1610. case TCL_DB_BTREE:
  1611. if (type != DB_UNKNOWN) {
  1612. Tcl_SetResult(interp,
  1613.     "Too many DB types specified", TCL_STATIC);
  1614. result = TCL_ERROR;
  1615. goto error;
  1616. }
  1617. type = DB_BTREE;
  1618. break;
  1619. case TCL_DB_HASH:
  1620. if (type != DB_UNKNOWN) {
  1621. Tcl_SetResult(interp,
  1622.     "Too many DB types specified", TCL_STATIC);
  1623. result = TCL_ERROR;
  1624. goto error;
  1625. }
  1626. type = DB_HASH;
  1627. break;
  1628. case TCL_DB_RECNO:
  1629. if (type != DB_UNKNOWN) {
  1630. Tcl_SetResult(interp,
  1631.     "Too many DB types specified", TCL_STATIC);
  1632. result = TCL_ERROR;
  1633. goto error;
  1634. }
  1635. type = DB_RECNO;
  1636. break;
  1637. case TCL_DB_QUEUE:
  1638. if (type != DB_UNKNOWN) {
  1639. Tcl_SetResult(interp,
  1640.     "Too many DB types specified", TCL_STATIC);
  1641. result = TCL_ERROR;
  1642. goto error;
  1643. }
  1644. type = DB_QUEUE;
  1645. break;
  1646. case TCL_DB_UNKNOWN:
  1647. if (type != DB_UNKNOWN) {
  1648. Tcl_SetResult(interp,
  1649.     "Too many DB types specified", TCL_STATIC);
  1650. result = TCL_ERROR;
  1651. goto error;
  1652. }
  1653. break;
  1654. case TCL_DB_CREATE:
  1655. open_flags |= DB_CREATE;
  1656. break;
  1657. case TCL_DB_EXCL:
  1658. open_flags |= DB_EXCL;
  1659. break;
  1660. case TCL_DB_RDONLY:
  1661. open_flags |= DB_RDONLY;
  1662. break;
  1663. case TCL_DB_TRUNCATE:
  1664. open_flags |= DB_TRUNCATE;
  1665. break;
  1666. case TCL_DB_MODE:
  1667. if (i >= objc) {
  1668. Tcl_WrongNumArgs(interp, 2, objv,
  1669.     "?-mode mode?");
  1670. result = TCL_ERROR;
  1671. break;
  1672. }
  1673. /*
  1674.  * Don't need to check result here because
  1675.  * if TCL_ERROR, the error message is already
  1676.  * set up, and we'll bail out below.  If ok,
  1677.  * the mode is set and we go on.
  1678.  */
  1679. result = Tcl_GetIntFromObj(interp, objv[i++], &mode);
  1680. break;
  1681. case TCL_DB_DUP:
  1682. set_flags |= DB_DUP;
  1683. break;
  1684. case TCL_DB_DUPSORT:
  1685. set_flags |= DB_DUPSORT;
  1686. break;
  1687. case TCL_DB_RECNUM:
  1688. set_flags |= DB_RECNUM;
  1689. break;
  1690. case TCL_DB_RENUMBER:
  1691. set_flags |= DB_RENUMBER;
  1692. break;
  1693. case TCL_DB_SNAPSHOT:
  1694. set_flags |= DB_SNAPSHOT;
  1695. break;
  1696. case TCL_DB_CHKSUM:
  1697. set_flags |= DB_CHKSUM_SHA1;
  1698. break;
  1699. case TCL_DB_ENCRYPT:
  1700. set_flags |= DB_ENCRYPT;
  1701. break;
  1702. case TCL_DB_ENCRYPT_AES:
  1703. /* Make sure we have an arg to check against! */
  1704. if (i >= objc) {
  1705. Tcl_WrongNumArgs(interp, 2, objv,
  1706.     "?-encryptaes passwd?");
  1707. result = TCL_ERROR;
  1708. break;
  1709. }
  1710. passwd = Tcl_GetStringFromObj(objv[i++], NULL);
  1711. _debug_check();
  1712. ret = (*dbp)->set_encrypt(*dbp, passwd, DB_ENCRYPT_AES);
  1713. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  1714.     "set_encrypt");
  1715. break;
  1716. case TCL_DB_ENCRYPT_ANY:
  1717. /* Make sure we have an arg to check against! */
  1718. if (i >= objc) {
  1719. Tcl_WrongNumArgs(interp, 2, objv,
  1720.     "?-encryptany passwd?");
  1721. result = TCL_ERROR;
  1722. break;
  1723. }
  1724. passwd = Tcl_GetStringFromObj(objv[i++], NULL);
  1725. _debug_check();
  1726. ret = (*dbp)->set_encrypt(*dbp, passwd, 0);
  1727. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  1728.     "set_encrypt");
  1729. break;
  1730. case TCL_DB_FFACTOR:
  1731. if (i >= objc) {
  1732. Tcl_WrongNumArgs(interp, 2, objv,
  1733.     "-ffactor density");
  1734. result = TCL_ERROR;
  1735. break;
  1736. }
  1737. result = _GetUInt32(interp, objv[i++], &uintarg);
  1738. if (result == TCL_OK) {
  1739. _debug_check();
  1740. ret = (*dbp)->set_h_ffactor(*dbp, uintarg);
  1741. result = _ReturnSetup(interp, ret,
  1742.     DB_RETOK_STD(ret), "set_h_ffactor");
  1743. }
  1744. break;
  1745. case TCL_DB_NELEM:
  1746. if (i >= objc) {
  1747. Tcl_WrongNumArgs(interp, 2, objv,
  1748.     "-nelem nelem");
  1749. result = TCL_ERROR;
  1750. break;
  1751. }
  1752. result = _GetUInt32(interp, objv[i++], &uintarg);
  1753. if (result == TCL_OK) {
  1754. _debug_check();
  1755. ret = (*dbp)->set_h_nelem(*dbp, uintarg);
  1756. result = _ReturnSetup(interp, ret,
  1757.     DB_RETOK_STD(ret), "set_h_nelem");
  1758. }
  1759. break;
  1760. case TCL_DB_DELIM:
  1761. if (i >= objc) {
  1762. Tcl_WrongNumArgs(interp, 2, objv,
  1763.     "-delim delim");
  1764. result = TCL_ERROR;
  1765. break;
  1766. }
  1767. result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
  1768. if (result == TCL_OK) {
  1769. _debug_check();
  1770. ret = (*dbp)->set_re_delim(*dbp, intarg);
  1771. result = _ReturnSetup(interp, ret,
  1772.     DB_RETOK_STD(ret), "set_re_delim");
  1773. }
  1774. break;
  1775. case TCL_DB_LEN:
  1776. if (i >= objc) {
  1777. Tcl_WrongNumArgs(interp, 2, objv,
  1778.     "-len length");
  1779. result = TCL_ERROR;
  1780. break;
  1781. }
  1782. result = _GetUInt32(interp, objv[i++], &uintarg);
  1783. if (result == TCL_OK) {
  1784. _debug_check();
  1785. ret = (*dbp)->set_re_len(*dbp, uintarg);
  1786. result = _ReturnSetup(interp, ret,
  1787.     DB_RETOK_STD(ret), "set_re_len");
  1788. }
  1789. break;
  1790. case TCL_DB_PAD:
  1791. if (i >= objc) {
  1792. Tcl_WrongNumArgs(interp, 2, objv,
  1793.     "-pad pad");
  1794. result = TCL_ERROR;
  1795. break;
  1796. }
  1797. result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
  1798. if (result == TCL_OK) {
  1799. _debug_check();
  1800. ret = (*dbp)->set_re_pad(*dbp, intarg);
  1801. result = _ReturnSetup(interp, ret,
  1802.     DB_RETOK_STD(ret), "set_re_pad");
  1803. }
  1804. break;
  1805. case TCL_DB_SOURCE:
  1806. if (i >= objc) {
  1807. Tcl_WrongNumArgs(interp, 2, objv,
  1808.     "-source file");
  1809. result = TCL_ERROR;
  1810. break;
  1811. }
  1812. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  1813. _debug_check();
  1814. ret = (*dbp)->set_re_source(*dbp, arg);
  1815. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  1816.     "set_re_source");
  1817. break;
  1818. case TCL_DB_EXTENT:
  1819. if (i >= objc) {
  1820. Tcl_WrongNumArgs(interp, 2, objv,
  1821.     "-extent size");
  1822. result = TCL_ERROR;
  1823. break;
  1824. }
  1825. result = _GetUInt32(interp, objv[i++], &uintarg);
  1826. if (result == TCL_OK) {
  1827. _debug_check();
  1828. ret = (*dbp)->set_q_extentsize(*dbp, uintarg);
  1829. result = _ReturnSetup(interp, ret,
  1830.     DB_RETOK_STD(ret), "set_q_extentsize");
  1831. }
  1832. break;
  1833. case TCL_DB_CACHESIZE:
  1834. result = Tcl_ListObjGetElements(interp, objv[i++],
  1835.     &myobjc, &myobjv);
  1836. if (result != TCL_OK)
  1837. break;
  1838. if (myobjc != 3) {
  1839. Tcl_WrongNumArgs(interp, 2, objv,
  1840.     "?-cachesize {gbytes bytes ncaches}?");
  1841. result = TCL_ERROR;
  1842. break;
  1843. }
  1844. result = _GetUInt32(interp, myobjv[0], &gbytes);
  1845. if (result != TCL_OK)
  1846. break;
  1847. result = _GetUInt32(interp, myobjv[1], &bytes);
  1848. if (result != TCL_OK)
  1849. break;
  1850. result = _GetUInt32(interp, myobjv[2], &ncaches);
  1851. if (result != TCL_OK)
  1852. break;
  1853. _debug_check();
  1854. ret = (*dbp)->set_cachesize(*dbp, gbytes, bytes,
  1855.     ncaches);
  1856. result = _ReturnSetup(interp, ret,
  1857.     DB_RETOK_STD(ret), "set_cachesize");
  1858. break;
  1859. case TCL_DB_PAGESIZE:
  1860. if (i >= objc) {
  1861. Tcl_WrongNumArgs(interp, 2, objv,
  1862.     "?-pagesize size?");
  1863. result = TCL_ERROR;
  1864. break;
  1865. }
  1866. result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
  1867. if (result == TCL_OK) {
  1868. _debug_check();
  1869. ret = (*dbp)->set_pagesize(*dbp,
  1870.     (size_t)intarg);
  1871. result = _ReturnSetup(interp, ret,
  1872.     DB_RETOK_STD(ret), "set pagesize");
  1873. }
  1874. break;
  1875. case TCL_DB_ERRFILE:
  1876. if (i >= objc) {
  1877. Tcl_WrongNumArgs(interp, 2, objv,
  1878.     "-errfile file");
  1879. result = TCL_ERROR;
  1880. break;
  1881. }
  1882. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  1883. /*
  1884.  * If the user already set one, close it.
  1885.  */
  1886. if (errip->i_err != NULL)
  1887. fclose(errip->i_err);
  1888. errip->i_err = fopen(arg, "a");
  1889. if (errip->i_err != NULL) {
  1890. _debug_check();
  1891. (*dbp)->set_errfile(*dbp, errip->i_err);
  1892. set_err = 1;
  1893. }
  1894. break;
  1895. case TCL_DB_ERRPFX:
  1896. if (i >= objc) {
  1897. Tcl_WrongNumArgs(interp, 2, objv,
  1898.     "-errpfx prefix");
  1899. result = TCL_ERROR;
  1900. break;
  1901. }
  1902. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  1903. /*
  1904.  * If the user already set one, free it.
  1905.  */
  1906. if (errip->i_errpfx != NULL)
  1907. __os_free(NULL, errip->i_errpfx);
  1908. if ((ret = __os_strdup((*dbp)->dbenv,
  1909.     arg, &errip->i_errpfx)) != 0) {
  1910. result = _ReturnSetup(interp, ret,
  1911.     DB_RETOK_STD(ret), "__os_strdup");
  1912. break;
  1913. }
  1914. if (errip->i_errpfx != NULL) {
  1915. _debug_check();
  1916. (*dbp)->set_errpfx(*dbp, errip->i_errpfx);
  1917. set_pfx = 1;
  1918. }
  1919. break;
  1920. case TCL_DB_ENDARG:
  1921. endarg = 1;
  1922. break;
  1923. } /* switch */
  1925. /*
  1926.  * If, at any time, parsing the args we get an error,
  1927.  * bail out and return.
  1928.  */
  1929. if (result != TCL_OK)
  1930. goto error;
  1931. if (endarg)
  1932. break;
  1933. }
  1934. if (result != TCL_OK)
  1935. goto error;
  1937. /*
  1938.  * Any args we have left, (better be 0, 1 or 2 left) are
  1939.  * file names.  If we have 0, then an in-memory db.  If
  1940.  * there is 1, a db name, if 2 a db and subdb name.
  1941.  */
  1942. if (i != objc) {
  1943. /*
  1944.  * Dbs must be NULL terminated file names, but subdbs can
  1945.  * be anything.  Use Strings for the db name and byte
  1946.  * arrays for the subdb.
  1947.  */
  1948. db = Tcl_GetStringFromObj(objv[i++], NULL);
  1949. if (i != objc) {
  1950. subdbtmp =
  1951.     Tcl_GetByteArrayFromObj(objv[i++], &subdblen);
  1952. if ((ret = __os_malloc(envp,
  1953.    subdblen + 1, &subdb)) != 0) {
  1954. Tcl_SetResult(interp, db_strerror(ret),
  1955.     TCL_STATIC);
  1956. return (0);
  1957. }
  1958. memcpy(subdb, subdbtmp, subdblen);
  1959. subdb[subdblen] = '';
  1960. }
  1961. }
  1962. if (set_flags) {
  1963. ret = (*dbp)->set_flags(*dbp, set_flags);
  1964. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  1965.     "set_flags");
  1966. if (result == TCL_ERROR)
  1967. goto error;
  1968. /*
  1969.  * If we are successful, clear the result so that the
  1970.  * return from set_flags isn't part of the result.
  1971.  */
  1972. Tcl_ResetResult(interp);
  1973. }
  1975. /*
  1976.  * When we get here, we have already parsed all of our args and made
  1977.  * all our calls to set up the database.  Everything is okay so far,
  1978.  * no errors, if we get here.
  1979.  */
  1980. _debug_check();
  1982. /* Open the database. */
  1983. ret = (*dbp)->open(*dbp, txn, db, subdb, type, open_flags, mode);
  1984. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db open");
  1986. error:
  1987. if (subdb)
  1988. __os_free(envp, subdb);
  1989. if (result == TCL_ERROR) {
  1990. (void)(*dbp)->close(*dbp, 0);
  1991. /*
  1992.  * If we opened and set up the error file in the environment
  1993.  * on this open, but we failed for some other reason, clean
  1994.  * up and close the file.
  1995.  *
  1996.  * XXX when err stuff isn't tied to env, change to use ip,
  1997.  * instead of envip.  Also, set_err is irrelevant when that
  1998.  * happens.  It will just read:
  1999.  * if (ip->i_err)
  2000.  * fclose(ip->i_err);
  2001.  */
  2002. if (set_err && errip && errip->i_err != NULL) {
  2003. fclose(errip->i_err);
  2004. errip->i_err = NULL;
  2005. }
  2006. if (set_pfx && errip && errip->i_errpfx != NULL) {
  2007. __os_free(envp, errip->i_errpfx);
  2008. errip->i_errpfx = NULL;
  2009. }
  2010. *dbp = NULL;
  2011. }
  2012. return (result);
  2013. }
  2015. /*
  2016.  * bdb_DbRemove --
  2017.  * Implements the DB_ENV->remove and DB->remove command.
  2018.  */
  2019. static int
  2020. bdb_DbRemove(interp, objc, objv)
  2021. Tcl_Interp *interp; /* Interpreter */
  2022. int objc; /* How many arguments? */
  2023. Tcl_Obj *CONST objv[]; /* The argument objects */
  2024. {
  2025. static char *bdbrem[] = {
  2026. "-auto_commit",
  2027. "-encrypt",
  2028. "-encryptaes",
  2029. "-encryptany",
  2030. "-env",
  2031. "-txn",
  2032. "--",
  2033. NULL
  2034. };
  2035. enum bdbrem {
  2036. TCL_DBREM_AUTOCOMMIT,
  2037. TCL_DBREM_ENCRYPT,
  2038. TCL_DBREM_ENCRYPT_AES,
  2039. TCL_DBREM_ENCRYPT_ANY,
  2040. TCL_DBREM_ENV,
  2041. TCL_DBREM_TXN,
  2042. TCL_DBREM_ENDARG
  2043. };
  2044. DB *dbp;
  2045. DB_ENV *envp;
  2046. DB_TXN *txn;
  2047. int endarg, i, optindex, result, ret, subdblen;
  2048. u_int32_t enc_flag, iflags, set_flags;
  2049. u_char *subdbtmp;
  2050. char *arg, *db, msg[MSG_SIZE], *passwd, *subdb;
  2052. db = subdb = NULL;
  2053. dbp = NULL;
  2054. endarg = 0;
  2055. envp = NULL;
  2056. iflags = enc_flag = set_flags = 0;
  2057. passwd = NULL;
  2058. result = TCL_OK;
  2059. subdbtmp = NULL;
  2060. txn = NULL;
  2062. if (objc < 2) {
  2063. Tcl_WrongNumArgs(interp, 2, objv, "?args? filename ?database?");
  2064. return (TCL_ERROR);
  2065. }
  2067. /*
  2068.  * We must first parse for the environment flag, since that
  2069.  * is needed for db_create.  Then create the db handle.
  2070.  */
  2071. i = 2;
  2072. while (i < objc) {
  2073. if (Tcl_GetIndexFromObj(interp, objv[i], bdbrem,
  2074.     "option", TCL_EXACT, &optindex) != TCL_OK) {
  2075. arg = Tcl_GetStringFromObj(objv[i], NULL);
  2076. if (arg[0] == '-') {
  2077. result = IS_HELP(objv[i]);
  2078. goto error;
  2079. } else
  2080. Tcl_ResetResult(interp);
  2081. break;
  2082. }
  2083. i++;
  2084. switch ((enum bdbrem)optindex) {
  2085. case TCL_DBREM_AUTOCOMMIT:
  2086. iflags |= DB_AUTO_COMMIT;
  2087. _debug_check();
  2088. break;
  2089. case TCL_DBREM_ENCRYPT:
  2090. set_flags |= DB_ENCRYPT;
  2091. _debug_check();
  2092. break;
  2093. case TCL_DBREM_ENCRYPT_AES:
  2094. /* Make sure we have an arg to check against! */
  2095. if (i >= objc) {
  2096. Tcl_WrongNumArgs(interp, 2, objv,
  2097.     "?-encryptaes passwd?");
  2098. result = TCL_ERROR;
  2099. break;
  2100. }
  2101. passwd = Tcl_GetStringFromObj(objv[i++], NULL);
  2102. enc_flag = DB_ENCRYPT_AES;
  2103. break;
  2104. case TCL_DBREM_ENCRYPT_ANY:
  2105. /* Make sure we have an arg to check against! */
  2106. if (i >= objc) {
  2107. Tcl_WrongNumArgs(interp, 2, objv,
  2108.     "?-encryptany passwd?");
  2109. result = TCL_ERROR;
  2110. break;
  2111. }
  2112. passwd = Tcl_GetStringFromObj(objv[i++], NULL);
  2113. enc_flag = 0;
  2114. break;
  2115. case TCL_DBREM_ENV:
  2116. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  2117. envp = NAME_TO_ENV(arg);
  2118. if (envp == NULL) {
  2119. Tcl_SetResult(interp,
  2120.     "db remove: illegal environment",
  2121.     TCL_STATIC);
  2122. return (TCL_ERROR);
  2123. }
  2124. break;
  2125. case TCL_DBREM_ENDARG:
  2126. endarg = 1;
  2127. break;
  2128. case TCL_DBREM_TXN:
  2129. if (i >= objc) {
  2130. Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?");
  2131. result = TCL_ERROR;
  2132. break;
  2133. }
  2134. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  2135. txn = NAME_TO_TXN(arg);
  2136. if (txn == NULL) {
  2137. snprintf(msg, MSG_SIZE,
  2138.     "Put: Invalid txn: %sn", arg);
  2139. Tcl_SetResult(interp, msg, TCL_VOLATILE);
  2140. result = TCL_ERROR;
  2141. }
  2142. break;
  2143. }
  2144. /*
  2145.  * If, at any time, parsing the args we get an error,
  2146.  * bail out and return.
  2147.  */
  2148. if (result != TCL_OK)
  2149. goto error;
  2150. if (endarg)
  2151. break;
  2152. }
  2153. if (result != TCL_OK)
  2154. goto error;
  2155. /*
  2156.  * Any args we have left, (better be 1 or 2 left) are
  2157.  * file names. If there is 1, a db name, if 2 a db and subdb name.
  2158.  */
  2159. if ((i != (objc - 1)) || (i != (objc - 2))) {
  2160. /*
  2161.  * Dbs must be NULL terminated file names, but subdbs can
  2162.  * be anything.  Use Strings for the db name and byte
  2163.  * arrays for the subdb.
  2164.  */
  2165. db = Tcl_GetStringFromObj(objv[i++], NULL);
  2166. if (i != objc) {
  2167. subdbtmp =
  2168.     Tcl_GetByteArrayFromObj(objv[i++], &subdblen);
  2169. if ((ret = __os_malloc(envp, subdblen + 1,
  2170.     &subdb)) != 0) { Tcl_SetResult(interp,
  2171.     db_strerror(ret), TCL_STATIC);
  2172. return (0);
  2173. }
  2174. memcpy(subdb, subdbtmp, subdblen);
  2175. subdb[subdblen] = '';
  2176. }
  2177. } else {
  2178. Tcl_WrongNumArgs(interp, 2, objv, "?args? filename ?database?");
  2179. result = TCL_ERROR;
  2180. goto error;
  2181. }
  2182. if (envp == NULL) {
  2183. ret = db_create(&dbp, envp, 0);
  2184. if (ret) {
  2185. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  2186.     "db_create");
  2187. goto error;
  2188. }
  2190. if (passwd != NULL) {
  2191. ret = dbp->set_encrypt(dbp, passwd, enc_flag);
  2192. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  2193.     "set_encrypt");
  2194. }
  2195. if (set_flags != 0) {
  2196. ret = dbp->set_flags(dbp, set_flags);
  2197. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  2198.     "set_flags");
  2199. }
  2200. }
  2202. /*
  2203.  * No matter what, we NULL out dbp after this call.
  2204.  */
  2205. _debug_check();
  2206. if (dbp == NULL)
  2207. ret = envp->dbremove(envp, txn, db, subdb, iflags);
  2208. else
  2209. ret = dbp->remove(dbp, db, subdb, 0);
  2211. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db remove");
  2212. dbp = NULL;
  2213. error:
  2214. if (subdb)
  2215. __os_free(envp, subdb);
  2216. if (result == TCL_ERROR && dbp != NULL)
  2217. (void)dbp->close(dbp, 0);
  2218. return (result);
  2219. }
  2221. /*
  2222.  * bdb_DbRename --
  2223.  * Implements the DBENV->dbrename and DB->rename commands.
  2224.  */
  2225. static int
  2226. bdb_DbRename(interp, objc, objv)
  2227. Tcl_Interp *interp; /* Interpreter */
  2228. int objc; /* How many arguments? */
  2229. Tcl_Obj *CONST objv[]; /* The argument objects */
  2230. {
  2231. static char *bdbmv[] = {
  2232. "-auto_commit",
  2233. "-encrypt",
  2234. "-encryptaes",
  2235. "-encryptany",
  2236. "-env",
  2237. "-txn",
  2238. "--",
  2239. NULL
  2240. };
  2241. enum bdbmv {
  2242. TCL_DBMV_AUTOCOMMIT,
  2243. TCL_DBMV_ENCRYPT,
  2244. TCL_DBMV_ENCRYPT_AES,
  2245. TCL_DBMV_ENCRYPT_ANY,
  2246. TCL_DBMV_ENV,
  2247. TCL_DBMV_TXN,
  2248. TCL_DBMV_ENDARG
  2249. };
  2250. DB *dbp;
  2251. DB_ENV *envp;
  2252. DB_TXN *txn;
  2253. u_int32_t enc_flag, iflags, set_flags;
  2254. int endarg, i, newlen, optindex, result, ret, subdblen;
  2255. u_char *subdbtmp;
  2256. char *arg, *db, msg[MSG_SIZE], *newname, *passwd, *subdb;
  2258. db = newname = subdb = NULL;
  2259. dbp = NULL;
  2260. endarg = 0;
  2261. envp = NULL;
  2262. iflags = enc_flag = set_flags = 0;
  2263. passwd = NULL;
  2264. result = TCL_OK;
  2265. subdbtmp = NULL;
  2266. txn = NULL;
  2268. if (objc < 2) {
  2269. Tcl_WrongNumArgs(interp,
  2270. 3, objv, "?args? filename ?database? ?newname?");
  2271. return (TCL_ERROR);
  2272. }
  2274. /*
  2275.  * We must first parse for the environment flag, since that
  2276.  * is needed for db_create.  Then create the db handle.
  2277.  */
  2278. i = 2;
  2279. while (i < objc) {
  2280. if (Tcl_GetIndexFromObj(interp, objv[i], bdbmv,
  2281.     "option", TCL_EXACT, &optindex) != TCL_OK) {
  2282. arg = Tcl_GetStringFromObj(objv[i], NULL);
  2283. if (arg[0] == '-') {
  2284. result = IS_HELP(objv[i]);
  2285. goto error;
  2286. } else
  2287. Tcl_ResetResult(interp);
  2288. break;
  2289. }
  2290. i++;
  2291. switch ((enum bdbmv)optindex) {
  2292. case TCL_DBMV_AUTOCOMMIT:
  2293. iflags |= DB_AUTO_COMMIT;
  2294. _debug_check();
  2295. break;
  2296. case TCL_DBMV_ENCRYPT:
  2297. set_flags |= DB_ENCRYPT;
  2298. _debug_check();
  2299. break;
  2300. case TCL_DBMV_ENCRYPT_AES:
  2301. /* Make sure we have an arg to check against! */
  2302. if (i >= objc) {
  2303. Tcl_WrongNumArgs(interp, 2, objv,
  2304.     "?-encryptaes passwd?");
  2305. result = TCL_ERROR;
  2306. break;
  2307. }
  2308. passwd = Tcl_GetStringFromObj(objv[i++], NULL);
  2309. enc_flag = DB_ENCRYPT_AES;
  2310. break;
  2311. case TCL_DBMV_ENCRYPT_ANY:
  2312. /* Make sure we have an arg to check against! */
  2313. if (i >= objc) {
  2314. Tcl_WrongNumArgs(interp, 2, objv,
  2315.     "?-encryptany passwd?");
  2316. result = TCL_ERROR;
  2317. break;
  2318. }
  2319. passwd = Tcl_GetStringFromObj(objv[i++], NULL);
  2320. enc_flag = 0;
  2321. break;
  2322. case TCL_DBMV_ENV:
  2323. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  2324. envp = NAME_TO_ENV(arg);
  2325. if (envp == NULL) {
  2326. Tcl_SetResult(interp,
  2327.     "db rename: illegal environment",
  2328.     TCL_STATIC);
  2329. return (TCL_ERROR);
  2330. }
  2331. break;
  2332. case TCL_DBMV_ENDARG:
  2333. endarg = 1;
  2334. break;
  2335. case TCL_DBMV_TXN:
  2336. if (i >= objc) {
  2337. Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?");
  2338. result = TCL_ERROR;
  2339. break;
  2340. }
  2341. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  2342. txn = NAME_TO_TXN(arg);
  2343. if (txn == NULL) {
  2344. snprintf(msg, MSG_SIZE,
  2345.     "Put: Invalid txn: %sn", arg);
  2346. Tcl_SetResult(interp, msg, TCL_VOLATILE);
  2347. result = TCL_ERROR;
  2348. }
  2349. break;
  2350. }
  2351. /*
  2352.  * If, at any time, parsing the args we get an error,
  2353.  * bail out and return.
  2354.  */
  2355. if (result != TCL_OK)
  2356. goto error;
  2357. if (endarg)
  2358. break;
  2359. }
  2360. if (result != TCL_OK)
  2361. goto error;
  2362. /*
  2363.  * Any args we have left, (better be 2 or 3 left) are
  2364.  * file names. If there is 2, a file name, if 3 a file and db name.
  2365.  */
  2366. if ((i != (objc - 2)) || (i != (objc - 3))) {
  2367. /*
  2368.  * Dbs must be NULL terminated file names, but subdbs can
  2369.  * be anything.  Use Strings for the db name and byte
  2370.  * arrays for the subdb.
  2371.  */
  2372. db = Tcl_GetStringFromObj(objv[i++], NULL);
  2373. if (i == objc - 2) {
  2374. subdbtmp =
  2375.     Tcl_GetByteArrayFromObj(objv[i++], &subdblen);
  2376. if ((ret = __os_malloc(envp, subdblen + 1,
  2377.     &subdb)) != 0) {
  2378. Tcl_SetResult(interp,
  2379.     db_strerror(ret), TCL_STATIC);
  2380. return (0);
  2381. }
  2382. memcpy(subdb, subdbtmp, subdblen);
  2383. subdb[subdblen] = '';
  2384. }
  2385. subdbtmp =
  2386.     Tcl_GetByteArrayFromObj(objv[i++], &newlen);
  2387. if ((ret = __os_malloc(envp, newlen + 1,
  2388.     &newname)) != 0) {
  2389. Tcl_SetResult(interp,
  2390.     db_strerror(ret), TCL_STATIC);
  2391. return (0);
  2392. }
  2393. memcpy(newname, subdbtmp, newlen);
  2394. newname[newlen] = '';
  2395. } else {
  2396. Tcl_WrongNumArgs(
  2397.     interp, 3, objv, "?args? filename ?database? ?newname?");
  2398. result = TCL_ERROR;
  2399. goto error;
  2400. }
  2401. if (envp == NULL) {
  2402. ret = db_create(&dbp, envp, 0);
  2403. if (ret) {
  2404. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  2405.     "db_create");
  2406. goto error;
  2407. }
  2408. if (passwd != NULL) {
  2409. ret = dbp->set_encrypt(dbp, passwd, enc_flag);
  2410. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  2411.     "set_encrypt");
  2412. }
  2413. if (set_flags != 0) {
  2414. ret = dbp->set_flags(dbp, set_flags);
  2415. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  2416.     "set_flags");
  2417. }
  2418. }
  2420. /*
  2421.  * No matter what, we NULL out dbp after this call.
  2422.  */
  2423. if (dbp == NULL)
  2424. ret = envp->dbrename(envp, txn, db, subdb, newname, iflags);
  2425. else
  2426. ret = dbp->rename(dbp, db, subdb, newname, 0);
  2427. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db rename");
  2428. dbp = NULL;
  2429. error:
  2430. if (subdb)
  2431. __os_free(envp, subdb);
  2432. if (newname)
  2433. __os_free(envp, newname);
  2434. if (result == TCL_ERROR && dbp != NULL)
  2435. (void)dbp->close(dbp, 0);
  2436. return (result);
  2437. }
  2439. #if CONFIG_TEST
  2440. /*
  2441.  * bdb_DbVerify --
  2442.  * Implements the DB->verify command.
  2443.  */
  2444. static int
  2445. bdb_DbVerify(interp, objc, objv)
  2446. Tcl_Interp *interp; /* Interpreter */
  2447. int objc; /* How many arguments? */
  2448. Tcl_Obj *CONST objv[]; /* The argument objects */
  2449. {
  2450. static char *bdbverify[] = {
  2451. "-encrypt",
  2452. "-encryptaes",
  2453. "-encryptany",
  2454. "-env",
  2455. "-errfile",
  2456. "-errpfx",
  2457. "--",
  2458. NULL
  2459. };
  2460. enum bdbvrfy {
  2461. TCL_DBVRFY_ENCRYPT,
  2462. TCL_DBVRFY_ENCRYPT_AES,
  2463. TCL_DBVRFY_ENCRYPT_ANY,
  2464. TCL_DBVRFY_ENV,
  2465. TCL_DBVRFY_ERRFILE,
  2466. TCL_DBVRFY_ERRPFX,
  2467. TCL_DBVRFY_ENDARG
  2468. };
  2469. DB_ENV *envp;
  2470. DB *dbp;
  2471. FILE *errf;
  2472. u_int32_t enc_flag, flags, set_flags;
  2473. int endarg, i, optindex, result, ret;
  2474. char *arg, *db, *errpfx, *passwd;
  2476. envp = NULL;
  2477. dbp = NULL;
  2478. passwd = NULL;
  2479. result = TCL_OK;
  2480. db = errpfx = NULL;
  2481. errf = NULL;
  2482. flags = endarg = 0;
  2483. enc_flag = set_flags = 0;
  2485. if (objc < 2) {
  2486. Tcl_WrongNumArgs(interp, 2, objv, "?args? filename");
  2487. return (TCL_ERROR);
  2488. }
  2490. /*
  2491.  * We must first parse for the environment flag, since that
  2492.  * is needed for db_create.  Then create the db handle.
  2493.  */
  2494. i = 2;
  2495. while (i < objc) {
  2496. if (Tcl_GetIndexFromObj(interp, objv[i], bdbverify,
  2497.     "option", TCL_EXACT, &optindex) != TCL_OK) {
  2498. arg = Tcl_GetStringFromObj(objv[i], NULL);
  2499. if (arg[0] == '-') {
  2500. result = IS_HELP(objv[i]);
  2501. goto error;
  2502. } else
  2503. Tcl_ResetResult(interp);
  2504. break;
  2505. }
  2506. i++;
  2507. switch ((enum bdbvrfy)optindex) {
  2508. case TCL_DBVRFY_ENCRYPT:
  2509. set_flags |= DB_ENCRYPT;
  2510. _debug_check();
  2511. break;
  2512. case TCL_DBVRFY_ENCRYPT_AES:
  2513. /* Make sure we have an arg to check against! */
  2514. if (i >= objc) {
  2515. Tcl_WrongNumArgs(interp, 2, objv,
  2516.     "?-encryptaes passwd?");
  2517. result = TCL_ERROR;
  2518. break;
  2519. }
  2520. passwd = Tcl_GetStringFromObj(objv[i++], NULL);
  2521. enc_flag = DB_ENCRYPT_AES;
  2522. break;
  2523. case TCL_DBVRFY_ENCRYPT_ANY:
  2524. /* Make sure we have an arg to check against! */
  2525. if (i >= objc) {
  2526. Tcl_WrongNumArgs(interp, 2, objv,
  2527.     "?-encryptany passwd?");
  2528. result = TCL_ERROR;
  2529. break;
  2530. }
  2531. passwd = Tcl_GetStringFromObj(objv[i++], NULL);
  2532. enc_flag = 0;
  2533. break;
  2534. case TCL_DBVRFY_ENV:
  2535. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  2536. envp = NAME_TO_ENV(arg);
  2537. if (envp == NULL) {
  2538. Tcl_SetResult(interp,
  2539.     "db verify: illegal environment",
  2540.     TCL_STATIC);
  2541. result = TCL_ERROR;
  2542. break;
  2543. }
  2544. break;
  2545. case TCL_DBVRFY_ERRFILE:
  2546. if (i >= objc) {
  2547. Tcl_WrongNumArgs(interp, 2, objv,
  2548.     "-errfile file");
  2549. result = TCL_ERROR;
  2550. break;
  2551. }
  2552. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  2553. /*
  2554.  * If the user already set one, close it.
  2555.  */
  2556. if (errf != NULL)
  2557. fclose(errf);
  2558. errf = fopen(arg, "a");
  2559. break;
  2560. case TCL_DBVRFY_ERRPFX:
  2561. if (i >= objc) {
  2562. Tcl_WrongNumArgs(interp, 2, objv,
  2563.     "-errpfx prefix");
  2564. result = TCL_ERROR;
  2565. break;
  2566. }
  2567. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  2568. /*
  2569.  * If the user already set one, free it.
  2570.  */
  2571. if (errpfx != NULL)
  2572. __os_free(envp, errpfx);
  2573. if ((ret = __os_strdup(NULL, arg, &errpfx)) != 0) {
  2574. result = _ReturnSetup(interp, ret,
  2575.     DB_RETOK_STD(ret), "__os_strdup");
  2576. break;
  2577. }
  2578. break;
  2579. case TCL_DBVRFY_ENDARG:
  2580. endarg = 1;
  2581. break;
  2582. }
  2583. /*
  2584.  * If, at any time, parsing the args we get an error,
  2585.  * bail out and return.
  2586.  */
  2587. if (result != TCL_OK)
  2588. goto error;
  2589. if (endarg)
  2590. break;
  2591. }
  2592. if (result != TCL_OK)
  2593. goto error;
  2594. /*
  2595.  * The remaining arg is the db filename.
  2596.  */
  2597. if (i == (objc - 1))
  2598. db = Tcl_GetStringFromObj(objv[i++], NULL);
  2599. else {
  2600. Tcl_WrongNumArgs(interp, 2, objv, "?args? filename");
  2601. result = TCL_ERROR;
  2602. goto error;
  2603. }
  2604. ret = db_create(&dbp, envp, 0);
  2605. if (ret) {
  2606. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  2607.     "db_create");
  2608. goto error;
  2609. }
  2611. if (passwd != NULL) {
  2612. ret = dbp->set_encrypt(dbp, passwd, enc_flag);
  2613. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  2614.     "set_encrypt");
  2615. }
  2617. if (set_flags != 0) {
  2618. ret = dbp->set_flags(dbp, set_flags);
  2619. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  2620.     "set_flags");
  2621. }
  2622. if (errf != NULL)
  2623. dbp->set_errfile(dbp, errf);
  2624. if (errpfx != NULL)
  2625. dbp->set_errpfx(dbp, errpfx);
  2627. ret = dbp->verify(dbp, db, NULL, NULL, flags);
  2628. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db verify");
  2629. error:
  2630. if (errf != NULL)
  2631. fclose(errf);
  2632. if (errpfx != NULL)
  2633. __os_free(envp, errpfx);
  2634. if (dbp)
  2635. (void)dbp->close(dbp, 0);
  2636. return (result);
  2637. }
  2638. #endif
  2640. /*
  2641.  * bdb_Version --
  2642.  * Implements the version command.
  2643.  */
  2644. static int
  2645. bdb_Version(interp, objc, objv)
  2646. Tcl_Interp *interp; /* Interpreter */
  2647. int objc; /* How many arguments? */
  2648. Tcl_Obj *CONST objv[]; /* The argument objects */
  2649. {
  2650. static char *bdbver[] = {
  2651. "-string", NULL
  2652. };
  2653. enum bdbver {
  2654. TCL_VERSTRING
  2655. };
  2656. int i, optindex, maj, min, patch, result, string, verobjc;
  2657. char *arg, *v;
  2658. Tcl_Obj *res, *verobjv[3];
  2660. result = TCL_OK;
  2661. string = 0;
  2663. if (objc < 2) {
  2664. Tcl_WrongNumArgs(interp, 2, objv, "?args?");
  2665. return (TCL_ERROR);
  2666. }
  2668. /*
  2669.  * We must first parse for the environment flag, since that
  2670.  * is needed for db_create.  Then create the db handle.
  2671.  */
  2672. i = 2;
  2673. while (i < objc) {
  2674. if (Tcl_GetIndexFromObj(interp, objv[i], bdbver,
  2675.     "option", TCL_EXACT, &optindex) != TCL_OK) {
  2676. arg = Tcl_GetStringFromObj(objv[i], NULL);
  2677. if (arg[0] == '-') {
  2678. result = IS_HELP(objv[i]);
  2679. goto error;
  2680. } else
  2681. Tcl_ResetResult(interp);
  2682. break;
  2683. }
  2684. i++;
  2685. switch ((enum bdbver)optindex) {
  2686. case TCL_VERSTRING:
  2687. string = 1;
  2688. break;
  2689. }
  2690. /*
  2691.  * If, at any time, parsing the args we get an error,
  2692.  * bail out and return.
  2693.  */
  2694. if (result != TCL_OK)
  2695. goto error;
  2696. }
  2697. if (result != TCL_OK)
  2698. goto error;
  2700. v = db_version(&maj, &min, &patch);
  2701. if (string)
  2702. res = Tcl_NewStringObj(v, strlen(v));
  2703. else {
  2704. verobjc = 3;
  2705. verobjv[0] = Tcl_NewIntObj(maj);
  2706. verobjv[1] = Tcl_NewIntObj(min);
  2707. verobjv[2] = Tcl_NewIntObj(patch);
  2708. res = Tcl_NewListObj(verobjc, verobjv);
  2709. }
  2710. Tcl_SetObjResult(interp, res);
  2711. error:
  2712. return (result);
  2713. }
  2715. #if CONFIG_TEST
  2716. /*
  2717.  * bdb_Handles --
  2718.  * Implements the handles command.
  2719.  */
  2720. static int
  2721. bdb_Handles(interp, objc, objv)
  2722. Tcl_Interp *interp; /* Interpreter */
  2723. int objc; /* How many arguments? */
  2724. Tcl_Obj *CONST objv[]; /* The argument objects */
  2725. {
  2726. DBTCL_INFO *p;
  2727. Tcl_Obj *res, *handle;
  2729. /*
  2730.  * No args.  Error if we have some
  2731.  */
  2732. if (objc != 2) {
  2733. Tcl_WrongNumArgs(interp, 2, objv, "");
  2734. return (TCL_ERROR);
  2735. }
  2736. res = Tcl_NewListObj(0, NULL);
  2738. for (p = LIST_FIRST(&__db_infohead); p != NULL;
  2739.     p = LIST_NEXT(p, entries)) {
  2740. handle = Tcl_NewStringObj(p->i_name, strlen(p->i_name));
  2741. if (Tcl_ListObjAppendElement(interp, res, handle) != TCL_OK)
  2742. return (TCL_ERROR);
  2743. }
  2744. Tcl_SetObjResult(interp, res);
  2745. return (TCL_OK);
  2746. }
  2747. #endif
  2749. #if CONFIG_TEST
  2750. /*
  2751.  * bdb_DbUpgrade --
  2752.  * Implements the DB->upgrade command.
  2753.  */
  2754. static int
  2755. bdb_DbUpgrade(interp, objc, objv)
  2756. Tcl_Interp *interp; /* Interpreter */
  2757. int objc; /* How many arguments? */
  2758. Tcl_Obj *CONST objv[]; /* The argument objects */
  2759. {
  2760. static char *bdbupg[] = {
  2761. "-dupsort", "-env", "--", NULL
  2762. };
  2763. enum bdbupg {
  2764. TCL_DBUPG_DUPSORT,
  2765. TCL_DBUPG_ENV,
  2766. TCL_DBUPG_ENDARG
  2767. };
  2768. DB_ENV *envp;
  2769. DB *dbp;
  2770. u_int32_t flags;
  2771. int endarg, i, optindex, result, ret;
  2772. char *arg, *db;
  2774. envp = NULL;
  2775. dbp = NULL;
  2776. result = TCL_OK;
  2777. db = NULL;
  2778. flags = endarg = 0;
  2780. if (objc < 2) {
  2781. Tcl_WrongNumArgs(interp, 2, objv, "?args? filename");
  2782. return (TCL_ERROR);
  2783. }
  2785. i = 2;
  2786. while (i < objc) {
  2787. if (Tcl_GetIndexFromObj(interp, objv[i], bdbupg,
  2788.     "option", TCL_EXACT, &optindex) != TCL_OK) {
  2789. arg = Tcl_GetStringFromObj(objv[i], NULL);
  2790. if (arg[0] == '-') {
  2791. result = IS_HELP(objv[i]);
  2792. goto error;
  2793. } else
  2794. Tcl_ResetResult(interp);
  2795. break;
  2796. }
  2797. i++;
  2798. switch ((enum bdbupg)optindex) {
  2799. case TCL_DBUPG_DUPSORT:
  2800. flags |= DB_DUPSORT;
  2801. break;
  2802. case TCL_DBUPG_ENV:
  2803. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  2804. envp = NAME_TO_ENV(arg);
  2805. if (envp == NULL) {
  2806. Tcl_SetResult(interp,
  2807.     "db upgrade: illegal environment",
  2808.     TCL_STATIC);
  2809. return (TCL_ERROR);
  2810. }
  2811. break;
  2812. case TCL_DBUPG_ENDARG:
  2813. endarg = 1;
  2814. break;
  2815. }
  2816. /*
  2817.  * If, at any time, parsing the args we get an error,
  2818.  * bail out and return.
  2819.  */
  2820. if (result != TCL_OK)
  2821. goto error;
  2822. if (endarg)
  2823. break;
  2824. }
  2825. if (result != TCL_OK)
  2826. goto error;
  2827. /*
  2828.  * The remaining arg is the db filename.
  2829.  */
  2830. if (i == (objc - 1))
  2831. db = Tcl_GetStringFromObj(objv[i++], NULL);
  2832. else {
  2833. Tcl_WrongNumArgs(interp, 2, objv, "?args? filename");
  2834. result = TCL_ERROR;
  2835. goto error;
  2836. }
  2837. ret = db_create(&dbp, envp, 0);
  2838. if (ret) {
  2839. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  2840.     "db_create");
  2841. goto error;
  2842. }
  2844. ret = dbp->upgrade(dbp, db, flags);
  2845. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db upgrade");
  2846. error:
  2847. if (dbp)
  2848. (void)dbp->close(dbp, 0);
  2849. return (result);
  2850. }
  2851. #endif
  2853. /*
  2854.  * tcl_bt_compare and tcl_dup_compare --
  2855.  * These two are basically identical internally, so may as well
  2856.  * share code.  The only differences are the name used in error
  2857.  * reporting and the Tcl_Obj representing their respective procs.
  2858.  */
  2859. static int
  2860. tcl_bt_compare(dbp, dbta, dbtb)
  2861. DB *dbp;
  2862. const DBT *dbta, *dbtb;
  2863. {
  2864. return (tcl_compare_callback(dbp, dbta, dbtb,
  2865.     ((DBTCL_INFO *)dbp->api_internal)->i_btcompare, "bt_compare"));
  2866. }
  2868. static int
  2869. tcl_dup_compare(dbp, dbta, dbtb)
  2870. DB *dbp;
  2871. const DBT *dbta, *dbtb;
  2872. {
  2873. return (tcl_compare_callback(dbp, dbta, dbtb,
  2874.     ((DBTCL_INFO *)dbp->api_internal)->i_dupcompare, "dup_compare"));
  2875. }
  2877. /*
  2878.  * tcl_compare_callback --
  2879.  * Tcl callback for set_bt_compare and set_dup_compare. What this
  2880.  * function does is stuff the data fields of the two DBTs into Tcl ByteArray
  2881.  * objects, then call the procedure stored in ip->i_btcompare on the two
  2882.  * objects.  Then we return that procedure's result as the comparison.
  2883.  */
  2884. static int
  2885. tcl_compare_callback(dbp, dbta, dbtb, procobj, errname)
  2886. DB *dbp;
  2887. const DBT *dbta, *dbtb;
  2888. Tcl_Obj *procobj;
  2889. char *errname;
  2890. {
  2891. DBTCL_INFO *ip;
  2892. Tcl_Interp *interp;
  2893. Tcl_Obj *a, *b, *resobj, *objv[3];
  2894. int result, cmp;
  2896. ip = (DBTCL_INFO *)dbp->api_internal;
  2897. interp = ip->i_interp;
  2898. objv[0] = procobj;
  2900. /*
  2901.  * Create two ByteArray objects, with the two data we've been passed.
  2902.  * This will involve a copy, which is unpleasantly slow, but there's
  2903.  * little we can do to avoid this (I think).
  2904.  */
  2905. a = Tcl_NewByteArrayObj(dbta->data, dbta->size);
  2906. Tcl_IncrRefCount(a);
  2907. b = Tcl_NewByteArrayObj(dbtb->data, dbtb->size);
  2908. Tcl_IncrRefCount(b);
  2910. objv[1] = a;
  2911. objv[2] = b;
  2913. result = Tcl_EvalObjv(interp, 3, objv, 0);
  2914. if (result != TCL_OK) {
  2915. /*
  2916.  * XXX
  2917.  * If this or the next Tcl call fails, we're doomed.
  2918.  * There's no way to return an error from comparison functions,
  2919.  * no way to determine what the correct sort order is, and
  2920.  * so no way to avoid corrupting the database if we proceed.
  2921.  * We could play some games stashing return values on the
  2922.  * DB handle, but it's not worth the trouble--no one with
  2923.  * any sense is going to be using this other than for testing,
  2924.  * and failure typically means that the bt_compare proc
  2925.  * had a syntax error in it or something similarly dumb.
  2926.  *
  2927.  * So, drop core.  If we're not running with diagnostic
  2928.  * mode, panic--and always return a negative number. :-)
  2929.  */
  2930. panic: __db_err(dbp->dbenv, "Tcl %s callback failed", errname);
  2931. DB_ASSERT(0);
  2932. return (__db_panic(dbp->dbenv, DB_RUNRECOVERY));
  2933. }
  2935. resobj = Tcl_GetObjResult(interp);
  2936. result = Tcl_GetIntFromObj(interp, resobj, &cmp);
  2937. if (result != TCL_OK)
  2938. goto panic;
  2940. Tcl_DecrRefCount(a);
  2941. Tcl_DecrRefCount(b);
  2942. return (cmp);
  2943. }
  2945. /*
  2946.  * tcl_h_hash --
  2947.  * Tcl callback for the hashing function.  See tcl_compare_callback--
  2948.  * this works much the same way, only we're given a buffer and a length
  2949.  * instead of two DBTs.
  2950.  */
  2951. static u_int32_t
  2952. tcl_h_hash(dbp, buf, len)
  2953. DB *dbp;
  2954. const void *buf;
  2955. u_int32_t len;
  2956. {
  2957. DBTCL_INFO *ip;
  2958. Tcl_Interp *interp;
  2959. Tcl_Obj *objv[2];
  2960. int result, hval;
  2962. ip = (DBTCL_INFO *)dbp->api_internal;
  2963. interp = ip->i_interp;
  2964. objv[0] = ip->i_hashproc;
  2966. /*
  2967.  * Create a ByteArray for the buffer.
  2968.  */
  2969. objv[1] = Tcl_NewByteArrayObj((void *)buf, len);
  2970. Tcl_IncrRefCount(objv[1]);
  2971. result = Tcl_EvalObjv(interp, 2, objv, 0);
  2972. if (result != TCL_OK) {
  2973. /*
  2974.  * XXX
  2975.  * We drop core on error.  See the comment in
  2976.  * tcl_compare_callback.
  2977.  */
  2978. panic: __db_err(dbp->dbenv, "Tcl h_hash callback failed");
  2979. DB_ASSERT(0);
  2980. return (__db_panic(dbp->dbenv, DB_RUNRECOVERY));
  2981. }
  2983. result = Tcl_GetIntFromObj(interp, Tcl_GetObjResult(interp), &hval);
  2984. if (result != TCL_OK)
  2985. goto panic;
  2987. Tcl_DecrRefCount(objv[1]);
  2988. return (hval);
  2989. }
  2991. /*
  2992.  * tcl_rep_send --
  2993.  * Replication send callback.
  2994.  */
  2995. static int
  2996. tcl_rep_send(dbenv, control, rec, eid, flags)
  2997. DB_ENV *dbenv;
  2998. const DBT *control, *rec;
  2999. int eid;
  3000. u_int32_t flags;
  3001. {
  3002. DBTCL_INFO *ip;
  3003. Tcl_Interp *interp;
  3004. Tcl_Obj *control_o, *eid_o, *origobj, *rec_o, *resobj, *objv[5];
  3005. int result, ret;
  3007. COMPQUIET(flags, 0);
  3009. ip = (DBTCL_INFO *)dbenv->app_private;
  3010. interp = ip->i_interp;
  3011. objv[0] = ip->i_rep_send;
  3013. control_o = Tcl_NewByteArrayObj(control->data, control->size);
  3014. Tcl_IncrRefCount(control_o);
  3016. rec_o = Tcl_NewByteArrayObj(rec->data, rec->size);
  3017. Tcl_IncrRefCount(rec_o);
  3019. eid_o = Tcl_NewIntObj(eid);
  3020. Tcl_IncrRefCount(eid_o);
  3022. objv[1] = control_o;
  3023. objv[2] = rec_o;
  3024. objv[3] = ip->i_rep_eid; /* From ID */
  3025. objv[4] = eid_o; /* To ID */
  3027. /*
  3028.  * We really want to return the original result to the
  3029.  * user.  So, save the result obj here, and then after
  3030.  * we've taken care of the Tcl_EvalObjv, set the result
  3031.  * back to this original result.
  3032.  */
  3033. origobj = Tcl_GetObjResult(interp);
  3034. Tcl_IncrRefCount(origobj);
  3035. result = Tcl_EvalObjv(interp, 5, objv, 0);
  3036. if (result != TCL_OK) {
  3037. /*
  3038.  * XXX
  3039.  * This probably isn't the right error behavior, but
  3040.  * this error should only happen if the Tcl callback is
  3041.  * somehow invalid, which is a fatal scripting bug.
  3042.  */
  3043. err: __db_err(dbenv, "Tcl rep_send failure");
  3044. return (EINVAL);
  3045. }
  3047. resobj = Tcl_GetObjResult(interp);
  3048. result = Tcl_GetIntFromObj(interp, resobj, &ret);
  3049. if (result != TCL_OK)
  3050. goto err;
  3052. Tcl_SetObjResult(interp, origobj);
  3053. Tcl_DecrRefCount(origobj);
  3054. Tcl_DecrRefCount(control_o);
  3055. Tcl_DecrRefCount(rec_o);
  3056. Tcl_DecrRefCount(eid_o);
  3058. return (ret);
  3059. }
  3061. #ifdef TEST_ALLOC
  3062. /*
  3063.  * tcl_db_malloc, tcl_db_realloc, tcl_db_free --
  3064.  * Tcl-local malloc, realloc, and free functions to use for user data
  3065.  * to exercise umalloc/urealloc/ufree.  Allocate the memory as a Tcl object
  3066.  * so we're sure to exacerbate and catch any shared-library issues.
  3067.  */
  3068. static void *
  3069. tcl_db_malloc(size)
  3070. size_t size;
  3071. {
  3072. Tcl_Obj *obj;
  3073. void *buf;
  3075. obj = Tcl_NewObj();
  3076. if (obj == NULL)
  3077. return (NULL);
  3078. Tcl_IncrRefCount(obj);
  3080. Tcl_SetObjLength(obj, size + sizeof(Tcl_Obj *));
  3081. buf = Tcl_GetString(obj);
  3082. memcpy(buf, &obj, sizeof(&obj));
  3084. buf = (Tcl_Obj **)buf + 1;
  3085. return (buf);
  3086. }
  3088. static void *
  3089. tcl_db_realloc(ptr, size)
  3090. void *ptr;
  3091. size_t size;
  3092. {
  3093. Tcl_Obj *obj;
  3095. if (ptr == NULL)
  3096. return (tcl_db_malloc(size));
  3098. obj = *(Tcl_Obj **)((Tcl_Obj **)ptr - 1);
  3099. Tcl_SetObjLength(obj, size + sizeof(Tcl_Obj *));
  3101. ptr = Tcl_GetString(obj);
  3102. memcpy(ptr, &obj, sizeof(&obj));
  3104. ptr = (Tcl_Obj **)ptr + 1;
  3105. return (ptr);
  3106. }
  3108. static void
  3109. tcl_db_free(ptr)
  3110. void *ptr;
  3111. {
  3112. Tcl_Obj *obj;
  3114. obj = *(Tcl_Obj **)((Tcl_Obj **)ptr - 1);
  3115. Tcl_DecrRefCount(obj);
  3116. }
  3117. #endif