tcl_db_pkg.c

这是linux下运行的mysql软件包,可用于linux 下安装 php + mysql + apach 的网络配置

				ret = (*env)->set_shm_key(*env, shm);
				result = _ReturnSetup(interp, ret,
				    DB_RETOK_STD(ret), "shm_key");
			}
			break;
		case ENV_TXN_MAX:
			if (i >= objc) {
				Tcl_WrongNumArgs(interp, 2, objv,
				    "?-txn_max max?");
				result = TCL_ERROR;
				break;
			}
			result = _GetUInt32(interp, objv[i++], &uintarg);
			if (result == TCL_OK) {
				_debug_check();
				ret = (*env)->set_tx_max(*env, uintarg);
				result = _ReturnSetup(interp, ret,
				    DB_RETOK_STD(ret), "txn_max");
			}
			break;
		case ENV_ERRFILE:
			if (i >= objc) {
				Tcl_WrongNumArgs(interp, 2, objv,
				    "-errfile file");
				result = TCL_ERROR;
				break;
			}
			arg = Tcl_GetStringFromObj(objv[i++], NULL);
			/*
			 * If the user already set one, close it.
			 */
			if (ip->i_err != NULL)
				fclose(ip->i_err);
			ip->i_err = fopen(arg, "a");
			if (ip->i_err != NULL) {
				_debug_check();
				(*env)->set_errfile(*env, ip->i_err);
			}
			break;
		case ENV_ERRPFX:
			if (i >= objc) {
				Tcl_WrongNumArgs(interp, 2, objv,
				    "-errpfx prefix");
				result = TCL_ERROR;
				break;
			}
			arg = Tcl_GetStringFromObj(objv[i++], NULL);
			/*
			 * If the user already set one, free it.
			 */
			if (ip->i_errpfx != NULL)
				__os_free(NULL, ip->i_errpfx);
			if ((ret =
			    __os_strdup(*env, arg, &ip->i_errpfx)) != 0) {
				result = _ReturnSetup(interp, ret,
				    DB_RETOK_STD(ret), "__os_strdup");
				break;
			}
			if (ip->i_errpfx != NULL) {
				_debug_check();
				(*env)->set_errpfx(*env, ip->i_errpfx);
			}
			break;
		case ENV_DATA_DIR:
			if (i >= objc) {
				Tcl_WrongNumArgs(interp, 2, objv,
				    "-data_dir dir");
				result = TCL_ERROR;
				break;
			}
			arg = Tcl_GetStringFromObj(objv[i++], NULL);
			_debug_check();
			ret = (*env)->set_data_dir(*env, arg);
			result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
			    "set_data_dir");
			break;
		case ENV_LOG_DIR:
			if (i >= objc) {
				Tcl_WrongNumArgs(interp, 2, objv,
				    "-log_dir dir");
				result = TCL_ERROR;
				break;
			}
			arg = Tcl_GetStringFromObj(objv[i++], NULL);
			_debug_check();
			ret = (*env)->set_lg_dir(*env, arg);
			result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
			    "set_lg_dir");
			break;
		case ENV_TMP_DIR:
			if (i >= objc) {
				Tcl_WrongNumArgs(interp, 2, objv,
				    "-tmp_dir dir");
				result = TCL_ERROR;
				break;
			}
			arg = Tcl_GetStringFromObj(objv[i++], NULL);
			_debug_check();
			ret = (*env)->set_tmp_dir(*env, arg);
			result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
			    "set_tmp_dir");
			break;
		}
		/*
		 * If, at any time, parsing the args we get an error,
		 * bail out and return.
		 */
		if (result != TCL_OK)
			goto error;
	}

	/*
	 * We have to check this here.  We want to set the log buffer
	 * size first, if it is specified.  So if the user did so,
	 * then we took care of it above.  But, if we get out here and
	 * logmaxset is non-zero, then they set the log_max without
	 * resetting the log buffer size, so we now have to do the
	 * call to set_lg_max, since we didn't do it above.
	 */
	if (logmaxset) {
		_debug_check();
		ret = (*env)->set_lg_max(*env, (u_int32_t)logmaxset);
		result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
		    "log_max");
	}

	if (result != TCL_OK)
		goto error;

	if (set_flags) {
		ret = (*env)->set_flags(*env, set_flags, 1);
		result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
		    "set_flags");
		if (result == TCL_ERROR)
			goto error;
		/*
		 * If we are successful, clear the result so that the
		 * return from set_flags isn't part of the result.
		 */
		Tcl_ResetResult(interp);
	}
	/*
	 * When we get here, we have already parsed all of our args
	 * and made all our calls to set up the environment.  Everything
	 * is okay so far, no errors, if we get here.
	 *
	 * Now open the environment.
	 */
	_debug_check();
	ret = (*env)->open(*env, home, open_flags, mode);
	result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "env open");

	if (rep_flags != 0 && result == TCL_OK) {
		_debug_check();
		ret = (*env)->rep_start(*env, NULL, rep_flags);
		result = _ReturnSetup(interp,
		    ret, DB_RETOK_STD(ret), "rep_start");
	}

error:	if (result == TCL_ERROR) {
		if (ip->i_err) {
			fclose(ip->i_err);
			ip->i_err = NULL;
		}
		(void)(*env)->close(*env, 0);
		*env = NULL;
	}
	return (result);
}

/*
 * bdb_DbOpen --
 *	Implements the "db_create/db_open" command.
 *	There are many, many options to the open command.
 *	Here is the general flow:
 *
 *	0.  Preparse args to determine if we have -env.
 *	1.  Call db_create to create the db handle.
 *	2.  Parse args tracking options.
 *	3.  Make any pre-open setup calls necessary.
 *	4.  Call DB->open to open the database.
 *	5.  Return db widget handle to user.
 */
static int
bdb_DbOpen(interp, objc, objv, ip, dbp)
	Tcl_Interp *interp;		/* Interpreter */
	int objc;			/* How many arguments? */
	Tcl_Obj *CONST objv[];		/* The argument objects */
	DBTCL_INFO *ip;			/* Our internal info */
	DB **dbp;			/* DB handle */
{
	static char *bdbenvopen[] = {
		"-env",	NULL
	};
	enum bdbenvopen {
		TCL_DB_ENV0
	};
	static char *bdbopen[] = {
#if CONFIG_TEST
		"-btcompare",
		"-dirty",
		"-dupcompare",
		"-hashproc",
		"-lorder",
		"-minkey",
		"-nommap",
		"-revsplitoff",
		"-test",
#endif
		"-auto_commit",
		"-btree",
		"-cachesize",
		"-chksum",
		"-create",
		"-delim",
		"-dup",
		"-dupsort",
		"-encrypt",
		"-encryptaes",
		"-encryptany",
		"-env",
		"-errfile",
		"-errpfx",
		"-excl",
		"-extent",
		"-ffactor",
		"-hash",
		"-len",
		"-mode",
		"-nelem",
		"-pad",
		"-pagesize",
		"-queue",
		"-rdonly",
		"-recno",
		"-recnum",
		"-renumber",
		"-snapshot",
		"-source",
		"-truncate",
		"-txn",
		"-unknown",
		"--",
		NULL
	};
	enum bdbopen {
#if CONFIG_TEST
		TCL_DB_BTCOMPARE,
		TCL_DB_DIRTY,
		TCL_DB_DUPCOMPARE,
		TCL_DB_HASHPROC,
		TCL_DB_LORDER,
		TCL_DB_MINKEY,
		TCL_DB_NOMMAP,
		TCL_DB_REVSPLIT,
		TCL_DB_TEST,
#endif
		TCL_DB_AUTO_COMMIT,
		TCL_DB_BTREE,
		TCL_DB_CACHESIZE,
		TCL_DB_CHKSUM,
		TCL_DB_CREATE,
		TCL_DB_DELIM,
		TCL_DB_DUP,
		TCL_DB_DUPSORT,
		TCL_DB_ENCRYPT,
		TCL_DB_ENCRYPT_AES,
		TCL_DB_ENCRYPT_ANY,
		TCL_DB_ENV,
		TCL_DB_ERRFILE,
		TCL_DB_ERRPFX,
		TCL_DB_EXCL,
		TCL_DB_EXTENT,
		TCL_DB_FFACTOR,
		TCL_DB_HASH,
		TCL_DB_LEN,
		TCL_DB_MODE,
		TCL_DB_NELEM,
		TCL_DB_PAD,
		TCL_DB_PAGESIZE,
		TCL_DB_QUEUE,
		TCL_DB_RDONLY,
		TCL_DB_RECNO,
		TCL_DB_RECNUM,
		TCL_DB_RENUMBER,
		TCL_DB_SNAPSHOT,
		TCL_DB_SOURCE,
		TCL_DB_TRUNCATE,
		TCL_DB_TXN,
		TCL_DB_UNKNOWN,
		TCL_DB_ENDARG
	};

	DBTCL_INFO *envip, *errip;
	DB_TXN *txn;
	DBTYPE type;
	DB_ENV *envp;
	Tcl_Obj **myobjv;
	u_int32_t gbytes, bytes, ncaches, open_flags, uintarg;
	int endarg, i, intarg, mode, myobjc;
	int optindex, result, ret, set_err, set_flags, set_pfx, subdblen;
	u_char *subdbtmp;
	char *arg, *db, *passwd, *subdb, msg[MSG_SIZE];

	type = DB_UNKNOWN;
	endarg = mode = set_err = set_flags = set_pfx = 0;
	result = TCL_OK;
	subdbtmp = NULL;
	db = subdb = NULL;

	/*
	 * XXX
	 * If/when our Tcl interface becomes thread-safe, we should enable
	 * DB_THREAD here in all cases.  See comment in bdb_EnvOpen().
	 * For now, just turn it on when testing so that we exercise
	 * MUTEX_THREAD_LOCK cases.
	 */
	open_flags =
#ifdef TEST_THREAD
	    DB_THREAD;
#else
	    0;
#endif
	envp = NULL;
	txn = NULL;

	if (objc < 2) {
		Tcl_WrongNumArgs(interp, 2, objv, "?args?");
		return (TCL_ERROR);
	}

	/*
	 * We must first parse for the environment flag, since that
	 * is needed for db_create.  Then create the db handle.
	 */
	i = 2;
	while (i < objc) {
		if (Tcl_GetIndexFromObj(interp, objv[i++], bdbenvopen,
		    "option", TCL_EXACT, &optindex) != TCL_OK) {
			/*
			 * Reset the result so we don't get
			 * an errant error message if there is another error.
			 */
			Tcl_ResetResult(interp);
			continue;
		}
		switch ((enum bdbenvopen)optindex) {
		case TCL_DB_ENV0:
			arg = Tcl_GetStringFromObj(objv[i], NULL);
			envp = NAME_TO_ENV(arg);
			if (envp == NULL) {
				Tcl_SetResult(interp,
				    "db open: illegal environment", TCL_STATIC);
				return (TCL_ERROR);
			}
		}
		break;
	}

	/*
	 * Create the db handle before parsing the args
	 * since we'll be modifying the database options as we parse.
	 */
	ret = db_create(dbp, envp, 0);
	if (ret)
		return (_ReturnSetup(interp, ret, DB_RETOK_STD(ret),
		    "db_create"));

	/* Hang our info pointer on the DB handle, so we can do callbacks. */
	(*dbp)->api_internal = ip;

	/*
	 * XXX Remove restriction when err stuff is not tied to env.
	 *
	 * The DB->set_err* functions actually overwrite in the
	 * environment.  So, if we are explicitly using an env,
	 * don't overwrite what we have already set up.  If we are
	 * not using one, then we set up since we get a private
	 * default env.
	 */
	/* XXX  - remove this conditional if/when err is not tied to env */
	if (envp == NULL) {
		(*dbp)->set_errpfx((*dbp), ip->i_name);
		(*dbp)->set_errcall((*dbp), _ErrorFunc);
	}
	envip = _PtrToInfo(envp); /* XXX */
	/*
	 * If we are using an env, we keep track of err info in the env's ip.
	 * Otherwise use the DB's ip.
	 */
	if (envip)
		errip = envip;
	else
		errip = ip;
	/*
	 * Get the option name index from the object based on the args
	 * defined above.
	 */
	i = 2;
	while (i < objc) {
		Tcl_ResetResult(interp);
		if (Tcl_GetIndexFromObj(interp, objv[i], bdbopen, "option",
		    TCL_EXACT, &optindex) != TCL_OK) {
			arg = Tcl_GetStringFromObj(objv[i], NULL);
			if (arg[0] == '-') {
				result = IS_HELP(objv[i]);
				goto error;
			} else
				Tcl_ResetResult(interp);
			break;
		}
		i++;
		switch ((enum bdbopen)optindex) {
#if CONFIG_TEST
		case TCL_DB_BTCOMPARE:
			if (i >= objc) {
				Tcl_WrongNumArgs(interp, 2, objv,
				    "-btcompare compareproc");
				result = TCL_ERROR;
				break;
			}

			/*
			 * Store the object containing the procedure name.
			 * We don't need to crack it out now--we'll want
			 * to bundle it up to pass into Tcl_EvalObjv anyway.
			 * Tcl's object refcounting will--I hope--take care
			 * of the memory management here.
			 */
			ip->i_btcompare = objv[i++];
			Tcl_IncrRefCount(ip->i_btcompare);
			_debug_check();
			ret = (*dbp)->set_bt_compare(*dbp, tcl_bt_compare);
			result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
			    "set_bt_compare");
			break;
		case TCL_DB_DIRTY:
			open_flags |= DB_DIRTY_READ;
			break;
		case TCL_DB_DUPCOMPARE:
			if (i >= objc) {
				Tcl_WrongNumArgs(interp, 2, objv,
				    "-dupcompare compareproc");
				result = TCL_ERROR;
				break;
			}

			/*
			 * Store the object containing the procedure name.
			 * See TCL_DB_BTCOMPARE.
			 */
			ip->i_dupcompare = objv[i++];
			Tcl_IncrRefCount(ip->i_dupcompare);
			_debug_check();
			ret = (*dbp)->set_dup_compare(*dbp, tcl_dup_compare);
			result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
			    "set_dup_compare");
			break;
		case TCL_DB_HASHPROC:
			if (i >= objc) {
				Tcl_WrongNumArgs(interp, 2, objv,
				    "-hashproc hashproc");
				result = TCL_ERROR;
				break;
			}

			/*
			 * Store the object containing the procedure name.
			 * See TCL_DB_BTCOMPARE.
			 */
			ip->i_hashproc = objv[i++];
			Tcl_IncrRefCount(ip->i_hashproc);
			_debug_check();
			ret = (*dbp)->set_h_hash(*dbp, tcl_h_hash);
			result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
			    "set_h_hash");
			break;
		case TCL_DB_LORDER:
			if (i >= objc) {
				Tcl_WrongNumArgs(interp, 2, objv,
				    "-lorder 1234|4321");
				result = TCL_ERROR;
				break;
			}
			result = _GetUInt32(interp, objv[i++], &uintarg);
			if (result == TCL_OK) {
				_debug_check();
				ret = (*dbp)->set_lorder(*dbp, uintarg);
				result = _ReturnSetup(interp, ret,
				    DB_RETOK_STD(ret), "set_lorder");
			}
			break;
		case TCL_DB_MINKEY:
			if (i >= objc) {
				Tcl_WrongNumArgs(interp, 2, objv,
				    "-minkey minkey");
				result = TCL_ERROR;
				break;
			}
			result = _GetUInt32(interp, objv[i++], &uintarg);
			if (result == TCL_OK) {
				_debug_check();
				ret = (*dbp)->set_bt_minkey(*dbp, uintarg);
				result = _ReturnSetup(interp, ret,
				    DB_RETOK_STD(ret), "set_bt_minkey");
			}
			break;
		case TCL_DB_NOMMAP:
			open_flags |= DB_NOMMAP;
			break;
		case TCL_DB_REVSPLIT:
			set_flags |= DB_REVSPLITOFF;
			break;
		case TCL_DB_TEST:
			(*dbp)->set_h_hash(*dbp, __ham_test);
			break;
#endif
		case TCL_DB_AUTO_COMMIT:
			open_flags |= DB_AUTO_COMMIT;
			break;
		case TCL_DB_ENV:
			/*
			 * Already parsed this, skip it and the env pointer.
			 */
			i++;
			continue;
		case TCL_DB_TXN:
			if (i > (objc - 1)) {
				Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?");
				result = TCL_ERROR;
				break;
			}
			arg = Tcl_GetStringFromObj(objv[i++], NULL);
			txn = NAME_TO_TXN(arg);