tcl_env.c

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

	 */
	_debug_check();
	ret = e->remove(e, home, flag);
	result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
	    "env remove");
error:
	return (result);
}

static void
_EnvInfoDelete(interp, envip)
	Tcl_Interp *interp;		/* Tcl Interpreter */
	DBTCL_INFO *envip;		/* Info for env */
{
	DBTCL_INFO *nextp, *p;

	/*
	 * Before we can delete the environment info, we must close
	 * any open subsystems in this env.  We will:
	 * 1.  Abort any transactions (which aborts any nested txns).
	 * 2.  Close any mpools (which will put any pages itself).
	 * 3.  Put any locks and close log cursors.
	 * 4.  Close the error file.
	 */
	for (p = LIST_FIRST(&__db_infohead); p != NULL; p = nextp) {
		/*
		 * Check if this info structure "belongs" to this
		 * env.  If so, remove its commands and info structure.
		 * We do not close/abort/whatever here, because we
		 * don't want to replicate DB behavior.
		 *
		 * NOTE:  Only those types that can nest need to be
		 * itemized in the switch below.  That is txns and mps.
		 * Other types like log cursors and locks will just
		 * get cleaned up here.
		 */
		 if (p->i_parent == envip) {
			switch (p->i_type) {
			case I_TXN:
				_TxnInfoDelete(interp, p);
				break;
			case I_MP:
				_MpInfoDelete(interp, p);
				break;
			default:
				Tcl_SetResult(interp,
				    "_EnvInfoDelete: bad info type",
				    TCL_STATIC);
				break;
			}
			nextp = LIST_NEXT(p, entries);
			(void)Tcl_DeleteCommand(interp, p->i_name);
			_DeleteInfo(p);
		} else
			nextp = LIST_NEXT(p, entries);
	}
	(void)Tcl_DeleteCommand(interp, envip->i_name);
	_DeleteInfo(envip);
}

#if CONFIG_TEST
/*
 * PUBLIC: int tcl_EnvVerbose __P((Tcl_Interp *, DB_ENV *, Tcl_Obj *,
 * PUBLIC:    Tcl_Obj *));
 *
 * tcl_EnvVerbose --
 */
int
tcl_EnvVerbose(interp, dbenv, which, onoff)
	Tcl_Interp *interp;		/* Interpreter */
	DB_ENV *dbenv;			/* Env pointer */
	Tcl_Obj *which;			/* Which subsystem */
	Tcl_Obj *onoff;			/* On or off */
{
	static char *verbwhich[] = {
		"chkpt",
		"deadlock",
		"recovery",
		"rep",
		"wait",
		NULL
	};
	enum verbwhich {
		ENVVERB_CHK,
		ENVVERB_DEAD,
		ENVVERB_REC,
		ENVVERB_REP,
		ENVVERB_WAIT
	};
	static char *verbonoff[] = {
		"off",
		"on",
		NULL
	};
	enum verbonoff {
		ENVVERB_OFF,
		ENVVERB_ON
	};
	int on, optindex, ret;
	u_int32_t wh;

	if (Tcl_GetIndexFromObj(interp, which, verbwhich, "option",
	    TCL_EXACT, &optindex) != TCL_OK)
		return (IS_HELP(which));

	switch ((enum verbwhich)optindex) {
	case ENVVERB_CHK:
		wh = DB_VERB_CHKPOINT;
		break;
	case ENVVERB_DEAD:
		wh = DB_VERB_DEADLOCK;
		break;
	case ENVVERB_REC:
		wh = DB_VERB_RECOVERY;
		break;
	case ENVVERB_REP:
		wh = DB_VERB_REPLICATION;
		break;
	case ENVVERB_WAIT:
		wh = DB_VERB_WAITSFOR;
		break;
	default:
		return (TCL_ERROR);
	}
	if (Tcl_GetIndexFromObj(interp, onoff, verbonoff, "option",
	    TCL_EXACT, &optindex) != TCL_OK)
		return (IS_HELP(onoff));
	switch ((enum verbonoff)optindex) {
	case ENVVERB_OFF:
		on = 0;
		break;
	case ENVVERB_ON:
		on = 1;
		break;
	default:
		return (TCL_ERROR);
	}
	ret = dbenv->set_verbose(dbenv, wh, on);
	return (_ReturnSetup(interp, ret, DB_RETOK_STD(ret),
	    "env set verbose"));
}
#endif

#if	CONFIG_TEST
/*
 * PUBLIC: int tcl_EnvAttr __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *));
 *
 * tcl_EnvAttr --
 *	Return a list of the env's attributes
 */
int
tcl_EnvAttr(interp, objc, objv, dbenv)
	Tcl_Interp *interp;		/* Interpreter */
	int objc;			/* How many arguments? */
	Tcl_Obj *CONST objv[];		/* The argument objects */
	DB_ENV *dbenv;			/* Env pointer */
{
	int result;
	Tcl_Obj *myobj, *retlist;

	result = TCL_OK;

	if (objc > 2) {
		Tcl_WrongNumArgs(interp, 2, objv, NULL);
		return (TCL_ERROR);
	}
	retlist = Tcl_NewListObj(0, NULL);
	/*
	 * XXX
	 * We peek at the dbenv to determine what subsystems
	 * we have available in this env.
	 */
	myobj = Tcl_NewStringObj("-home", strlen("-home"));
	if ((result = Tcl_ListObjAppendElement(interp,
	    retlist, myobj)) != TCL_OK)
		goto err;
	myobj = Tcl_NewStringObj(dbenv->db_home, strlen(dbenv->db_home));
	if ((result = Tcl_ListObjAppendElement(interp,
	    retlist, myobj)) != TCL_OK)
		goto err;
	if (CDB_LOCKING(dbenv)) {
		myobj = Tcl_NewStringObj("-cdb", strlen("-cdb"));
		if ((result = Tcl_ListObjAppendElement(interp,
		    retlist, myobj)) != TCL_OK)
			goto err;
	}
	if (CRYPTO_ON(dbenv)) {
		myobj = Tcl_NewStringObj("-crypto", strlen("-crypto"));
		if ((result = Tcl_ListObjAppendElement(interp,
		    retlist, myobj)) != TCL_OK)
			goto err;
	}
	if (LOCKING_ON(dbenv)) {
		myobj = Tcl_NewStringObj("-lock", strlen("-lock"));
		if ((result = Tcl_ListObjAppendElement(interp,
		    retlist, myobj)) != TCL_OK)
			goto err;
	}
	if (LOGGING_ON(dbenv)) {
		myobj = Tcl_NewStringObj("-log", strlen("-log"));
		if ((result = Tcl_ListObjAppendElement(interp,
		    retlist, myobj)) != TCL_OK)
			goto err;
	}
	if (MPOOL_ON(dbenv)) {
		myobj = Tcl_NewStringObj("-mpool", strlen("-mpool"));
		if ((result = Tcl_ListObjAppendElement(interp,
		    retlist, myobj)) != TCL_OK)
			goto err;
	}
	if (RPC_ON(dbenv)) {
		myobj = Tcl_NewStringObj("-rpc", strlen("-rpc"));
		if ((result = Tcl_ListObjAppendElement(interp,
		    retlist, myobj)) != TCL_OK)
			goto err;
	}
	if (TXN_ON(dbenv)) {
		myobj = Tcl_NewStringObj("-txn", strlen("-txn"));
		if ((result = Tcl_ListObjAppendElement(interp,
		    retlist, myobj)) != TCL_OK)
			goto err;
	}
	Tcl_SetObjResult(interp, retlist);
err:
	return (result);
}

/*
 * PUBLIC: int tcl_EnvTest __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *));
 *
 * tcl_EnvTest --
 */
int
tcl_EnvTest(interp, objc, objv, dbenv)
	Tcl_Interp *interp;		/* Interpreter */
	int objc;			/* How many arguments? */
	Tcl_Obj *CONST objv[];		/* The argument objects */
	DB_ENV *dbenv;			/* Env pointer */
{
	static char *envtestcmd[] = {
		"abort",
		"copy",
		NULL
	};
	enum envtestcmd {
		ENVTEST_ABORT,
		ENVTEST_COPY
	};
	static char *envtestat[] = {
		"electinit",
		"electsend",
		"electvote1",
		"electvote2",
		"electwait1",
		"electwait2",
		"none",
		"predestroy",
		"preopen",
		"postdestroy",
		"postlog",
		"postlogmeta",
		"postopen",
		"postsync",
		"subdb_lock",
		NULL
	};
	enum envtestat {
		ENVTEST_ELECTINIT,
		ENVTEST_ELECTSEND,
		ENVTEST_ELECTVOTE1,
		ENVTEST_ELECTVOTE2,
		ENVTEST_ELECTWAIT1,
		ENVTEST_ELECTWAIT2,
		ENVTEST_NONE,
		ENVTEST_PREDESTROY,
		ENVTEST_PREOPEN,
		ENVTEST_POSTDESTROY,
		ENVTEST_POSTLOG,
		ENVTEST_POSTLOGMETA,
		ENVTEST_POSTOPEN,
		ENVTEST_POSTSYNC,
		ENVTEST_SUBDB_LOCKS
	};
	int *loc, optindex, result, testval;

	result = TCL_OK;
	loc = NULL;

	if (objc != 4) {
		Tcl_WrongNumArgs(interp, 2, objv, "abort|copy location");
		return (TCL_ERROR);
	}

	/*
	 * This must be the "copy" or "abort" portion of the command.
	 */
	if (Tcl_GetIndexFromObj(interp, objv[2], envtestcmd, "command",
	    TCL_EXACT, &optindex) != TCL_OK) {
		result = IS_HELP(objv[2]);
		return (result);
	}
	switch ((enum envtestcmd)optindex) {
	case ENVTEST_ABORT:
		loc = &dbenv->test_abort;
		break;
	case ENVTEST_COPY:
		loc = &dbenv->test_copy;
		break;
	default:
		Tcl_SetResult(interp, "Illegal store location", TCL_STATIC);
		return (TCL_ERROR);
	}

	/*
	 * This must be the location portion of the command.
	 */
	if (Tcl_GetIndexFromObj(interp, objv[3], envtestat, "location",
	    TCL_EXACT, &optindex) != TCL_OK) {
		result = IS_HELP(objv[3]);
		return (result);
	}
	switch ((enum envtestat)optindex) {
	case ENVTEST_ELECTINIT:
		DB_ASSERT(loc == &dbenv->test_abort);
		testval = DB_TEST_ELECTINIT;
		break;
	case ENVTEST_ELECTSEND:
		DB_ASSERT(loc == &dbenv->test_abort);
		testval = DB_TEST_ELECTSEND;
		break;
	case ENVTEST_ELECTVOTE1:
		DB_ASSERT(loc == &dbenv->test_abort);
		testval = DB_TEST_ELECTVOTE1;
		break;
	case ENVTEST_ELECTVOTE2:
		DB_ASSERT(loc == &dbenv->test_abort);
		testval = DB_TEST_ELECTVOTE2;
		break;
	case ENVTEST_ELECTWAIT1:
		DB_ASSERT(loc == &dbenv->test_abort);
		testval = DB_TEST_ELECTWAIT1;
		break;
	case ENVTEST_ELECTWAIT2:
		DB_ASSERT(loc == &dbenv->test_abort);
		testval = DB_TEST_ELECTWAIT2;
		break;
	case ENVTEST_NONE:
		testval = 0;
		break;
	case ENVTEST_PREOPEN:
		testval = DB_TEST_PREOPEN;
		break;
	case ENVTEST_PREDESTROY:
		testval = DB_TEST_PREDESTROY;
		break;
	case ENVTEST_POSTLOG:
		testval = DB_TEST_POSTLOG;
		break;
	case ENVTEST_POSTLOGMETA:
		testval = DB_TEST_POSTLOGMETA;
		break;
	case ENVTEST_POSTOPEN:
		testval = DB_TEST_POSTOPEN;
		break;
	case ENVTEST_POSTDESTROY:
		testval = DB_TEST_POSTDESTROY;
		break;
	case ENVTEST_POSTSYNC:
		testval = DB_TEST_POSTSYNC;
		break;
	case ENVTEST_SUBDB_LOCKS:
		DB_ASSERT(loc == &dbenv->test_abort);
		testval = DB_TEST_SUBDB_LOCKS;
		break;
	default:
		Tcl_SetResult(interp, "Illegal test location", TCL_STATIC);
		return (TCL_ERROR);
	}

	*loc = testval;
	Tcl_SetResult(interp, "0", TCL_STATIC);
	return (result);
}
#endif

/*
 * env_DbRemove --
 *	Implements the ENV->dbremove command.
 */
static int
env_DbRemove(interp, objc, objv, dbenv)
	Tcl_Interp *interp;		/* Interpreter */
	int objc;			/* How many arguments? */
	Tcl_Obj *CONST objv[];		/* The argument objects */
	DB_ENV *dbenv;
{
	static char *envdbrem[] = {
		"-auto_commit",
		"-txn",
		"--",
		NULL
	};
	enum envdbrem {
		TCL_EDBREM_COMMIT,
		TCL_EDBREM_TXN,
		TCL_EDBREM_ENDARG
	};
	DB_TXN *txn;
	u_int32_t flag;
	int endarg, i, optindex, result, ret, subdblen;
	u_char *subdbtmp;
	char *arg, *db, *subdb, msg[MSG_SIZE];

	txn = NULL;
	result = TCL_OK;
	subdbtmp = NULL;
	db = subdb = NULL;
	endarg = 0;
	flag = 0;

	if (objc < 2) {
		Tcl_WrongNumArgs(interp, 2, objv, "?args? filename ?database?");
		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], envdbrem,
		    "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 envdbrem)optindex) {
		case TCL_EDBREM_COMMIT:
			flag |= DB_AUTO_COMMIT;
			break;
		case TCL_EDBREM_TXN:
			if (i >= objc) {
				Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?");
				result = TCL_ERROR;
				break;
			}
			arg = Tcl_GetStringFromObj(objv[i++], NULL);
			txn = NAME_TO_TXN(arg);
			if (txn == NULL) {
				snprintf(msg, MSG_SIZE,
				    "env dbremove: Invalid txn %s\n", arg);
				Tcl_SetResult(interp, msg, TCL_VOLATILE);
				return (TCL_ERROR);
			}
			break;
		case TCL_EDBREM_ENDARG:
			endarg = 1;
			break;
		}
		/*
		 * If, at any time, parsing the args we get an error,
		 * bail out and return.
		 */
		if (result != TCL_OK)
			goto error;
		if (endarg)
			break;
	}
	if (result != TCL_OK)
		goto error;
	/*
	 * Any args we have left, (better be 1 or 2 left) are
	 * file names. If there is 1, a db name, if 2 a db and subdb name.
	 */
	if ((i != (objc - 1)) || (i != (objc - 2))) {
		/*
		 * Dbs must be NULL terminated file names, but subdbs can
		 * be anything.  Use Strings for the db name and byte
		 * arrays for the subdb.
		 */
		db = Tcl_GetStringFromObj(objv[i++], NULL);
		if (i != objc) {
			subdbtmp =
			    Tcl_GetByteArrayFromObj(objv[i++], &subdblen);
			if ((ret = __os_malloc(dbenv, subdblen + 1,
			    &subdb)) != 0) {
				Tcl_SetResult(interp,
				    db_strerror(ret), TCL_STATIC);
				return (0);
			}
			memcpy(subdb, subdbtmp, subdblen);
			subdb[subdblen] = '\0';
		}
	} else {
		Tcl_WrongNumArgs(interp, 2, objv, "?args? filename ?database?");
		result = TCL_ERROR;
		goto error;
	}
	ret = dbenv->dbremove(dbenv, txn, db, subdb, flag);
	result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
	    "env dbremove");
error:
	if (subdb)
		__os_free(dbenv, subdb);
	return (result);
}

/*
 * env_DbRename --
 *	Implements the ENV->dbrename command.
 */
static int
env_DbRename(interp, objc, objv, dbenv)
	Tcl_Interp *interp;		/* Interpreter */
	int objc;			/* How many arguments? */
	Tcl_Obj *CONST objv[];		/* The argument objects */
	DB_ENV *dbenv;
{
	static char *envdbmv[] = {
		"-auto_commit",
		"-txn",
		"--",
		NULL
	};
	enum envdbmv {
		TCL_EDBMV_COMMIT,
		TCL_EDBMV_TXN,
		TCL_EDBMV_ENDARG
	};
	DB_TXN *txn;
	u_int32_t flag;
	int endarg, i, newlen, optindex, result, ret, subdblen;
	u_char *subdbtmp;
	char *arg, *db, *newname, *subdb, msg[MSG_SIZE];

	txn = NULL;
	result = TCL_OK;
	subdbtmp = NULL;
	db = newname = subdb = NULL;
	endarg = 0;
	flag = 0;

	if (objc < 2) {
		Tcl_WrongNumArgs(interp, 3, objv,
		    "?args? filename ?database? ?newname?");
		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], envdbmv,
		    "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 envdbmv)optindex) {
		case TCL_EDBMV_COMMIT:
			flag |= DB_AUTO_COMMIT;
			break;
		case TCL_EDBMV_TXN:
			if (i >= objc) {
				Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?");
				result = TCL_ERROR;
				break;
			}
			arg = Tcl_GetStringFromObj(objv[i++], NULL);
			txn = NAME_TO_TXN(arg);
			if (txn == NULL) {
				snprintf(msg, MSG_SIZE,
				    "env dbrename: Invalid txn %s\n", arg);
				Tcl_SetResult(interp, msg, TCL_VOLATILE);
				return (TCL_ERROR);
			}
			break;
		case TCL_EDBMV_ENDARG:
			endarg = 1;
			break;
		}
		/*
		 * If, at any time, parsing the args we get an error,
		 * bail out and return.
		 */
		if (result != TCL_OK)
			goto error;
		if (endarg)
			break;
	}
	if (result != TCL_OK)
		goto error;
	/*
	 * Any args we have left, (better be 2 or 3 left) are
	 * file names. If there is 2, a db name, if 3 a db and subdb name.
	 */
	if ((i != (objc - 2)) || (i != (objc - 3))) {
		/*
		 * Dbs must be NULL terminated file names, but subdbs can
		 * be anything.  Use Strings for the db name and byte
		 * arrays for the subdb.
		 */
		db = Tcl_GetStringFromObj(objv[i++], NULL);
		if (i == objc - 2) {
			subdbtmp =
			    Tcl_GetByteArrayFromObj(objv[i++], &subdblen);
			if ((ret = __os_malloc(dbenv, subdblen + 1,
			    &subdb)) != 0) {
				Tcl_SetResult(interp,
				    db_strerror(ret), TCL_STATIC);
				return (0);
			}
			memcpy(subdb, subdbtmp, subdblen);
			subdb[subdblen] = '\0';
		}
		subdbtmp =
		    Tcl_GetByteArrayFromObj(objv[i++], &newlen);
		if ((ret = __os_malloc(dbenv, newlen + 1,
		    &newname)) != 0) {
			Tcl_SetResult(interp,
			    db_strerror(ret), TCL_STATIC);
			return (0);
		}
		memcpy(newname, subdbtmp, newlen);
		newname[newlen] = '\0';
	} else {
		Tcl_WrongNumArgs(interp, 3, objv,
		    "?args? filename ?database? ?newname?");
		result = TCL_ERROR;
		goto error;
	}
	ret = dbenv->dbrename(dbenv, txn, db, subdb, newname, flag);
	result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
	    "env dbrename");
error:
	if (subdb)
		__os_free(dbenv, subdb);
	if (newname)
		__os_free(dbenv, newname);
	return (result);
}