tcl_db_pkg.c

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

/*-
 * See the file LICENSE for redistribution information.
 *
 * Copyright (c) 1999-2002
 *	Sleepycat Software.  All rights reserved.
 */

#include "db_config.h"

#ifndef lint
static const char revid[] = "$Id: tcl_db_pkg.c,v 11.141 2002/08/14 20:15:47 bostic Exp $";
#endif /* not lint */

#ifndef NO_SYSTEM_INCLUDES
#include <sys/types.h>

#include <stdlib.h>
#include <string.h>
#include <tcl.h>
#endif

#if CONFIG_TEST
#define	DB_DBM_HSEARCH 1
#endif

#include "db_int.h"
#include "dbinc/db_page.h"
#include "dbinc/hash.h"
#include "dbinc/tcl_db.h"

/* XXX we must declare global data in just one place */
DBTCL_GLOBAL __dbtcl_global;

/*
 * Prototypes for procedures defined later in this file:
 */
static int	berkdb_Cmd __P((ClientData, Tcl_Interp *, int,
    Tcl_Obj * CONST*));
static int	bdb_EnvOpen __P((Tcl_Interp *, int, Tcl_Obj * CONST*,
    DBTCL_INFO *, DB_ENV **));
static int	bdb_DbOpen __P((Tcl_Interp *, int, Tcl_Obj * CONST*,
    DBTCL_INFO *, DB **));
static int	bdb_DbRemove __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
static int	bdb_DbRename __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
static int	bdb_DbUpgrade __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
static int	bdb_DbVerify __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
static int	bdb_Version __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
static int	bdb_Handles __P((Tcl_Interp *, int, Tcl_Obj * CONST*));

static int	tcl_bt_compare __P((DB *, const DBT *, const DBT *));
static int	tcl_compare_callback __P((DB *, const DBT *, const DBT *,
    Tcl_Obj *, char *));
static int	tcl_dup_compare __P((DB *, const DBT *, const DBT *));
static u_int32_t tcl_h_hash __P((DB *, const void *, u_int32_t));
static int	tcl_rep_send __P((DB_ENV *,
    const DBT *, const DBT *, int, u_int32_t));

#ifdef TEST_ALLOC
static void *	tcl_db_malloc __P((size_t));
static void *	tcl_db_realloc __P((void *, size_t));
static void	tcl_db_free __P((void *));
#endif

/*
 * Db_tcl_Init --
 *
 * This is a package initialization procedure, which is called by Tcl when
 * this package is to be added to an interpreter.  The name is based on the
 * name of the shared library, currently libdb_tcl-X.Y.so, which Tcl uses
 * to determine the name of this function.
 */
int
Db_tcl_Init(interp)
	Tcl_Interp *interp;		/* Interpreter in which the package is
					 * to be made available. */
{
	int code;

	code = Tcl_PkgProvide(interp, "Db_tcl", "1.0");
	if (code != TCL_OK)
		return (code);

	Tcl_CreateObjCommand(interp, "berkdb", (Tcl_ObjCmdProc *)berkdb_Cmd,
	    (ClientData)0, NULL);
	/*
	 * Create shared global debugging variables
	 */
	Tcl_LinkVar(interp, "__debug_on", (char *)&__debug_on, TCL_LINK_INT);
	Tcl_LinkVar(interp, "__debug_print", (char *)&__debug_print,
	    TCL_LINK_INT);
	Tcl_LinkVar(interp, "__debug_stop", (char *)&__debug_stop,
	    TCL_LINK_INT);
	Tcl_LinkVar(interp, "__debug_test", (char *)&__debug_test,
	    TCL_LINK_INT);
	LIST_INIT(&__db_infohead);
	return (TCL_OK);
}

/*
 * berkdb_cmd --
 *	Implements the "berkdb" command.
 *	This command supports three sub commands:
 *	berkdb version - Returns a list {major minor patch}
 *	berkdb env - Creates a new DB_ENV and returns a binding
 *	  to a new command of the form dbenvX, where X is an
 *	  integer starting at 0 (dbenv0, dbenv1, ...)
 *	berkdb open - Creates a new DB (optionally within
 *	  the given environment.  Returns a binding to a new
 *	  command of the form dbX, where X is an integer
 *	  starting at 0 (db0, db1, ...)
 */
static int
berkdb_Cmd(notused, interp, objc, objv)
	ClientData notused;		/* Not used. */
	Tcl_Interp *interp;		/* Interpreter */
	int objc;			/* How many arguments? */
	Tcl_Obj *CONST objv[];		/* The argument objects */
{
	static char *berkdbcmds[] = {
#if CONFIG_TEST
		"dbverify",
		"handles",
		"upgrade",
#endif
		"dbremove",
		"dbrename",
		"env",
		"envremove",
		"open",
		"version",
#if CONFIG_TEST
		/* All below are compatibility functions */
		"hcreate",	"hsearch",	"hdestroy",
		"dbminit",	"fetch",	"store",
		"delete",	"firstkey",	"nextkey",
		"ndbm_open",	"dbmclose",
#endif
		/* All below are convenience functions */
		"rand",		"random_int",	"srand",
		"debug_check",
		NULL
	};
	/*
	 * All commands enums below ending in X are compatibility
	 */
	enum berkdbcmds {
#if CONFIG_TEST
		BDB_DBVERIFY,
		BDB_HANDLES,
		BDB_UPGRADE,
#endif
		BDB_DBREMOVE,
		BDB_DBRENAME,
		BDB_ENV,
		BDB_ENVREMOVE,
		BDB_OPEN,
		BDB_VERSION,
#if CONFIG_TEST
		BDB_HCREATEX,	BDB_HSEARCHX,	BDB_HDESTROYX,
		BDB_DBMINITX,	BDB_FETCHX,	BDB_STOREX,
		BDB_DELETEX,	BDB_FIRSTKEYX,	BDB_NEXTKEYX,
		BDB_NDBMOPENX,	BDB_DBMCLOSEX,
#endif
		BDB_RANDX,	BDB_RAND_INTX,	BDB_SRANDX,
		BDB_DBGCKX
	};
	static int env_id = 0;
	static int db_id = 0;

	DB *dbp;
#if CONFIG_TEST
	DBM *ndbmp;
	static int ndbm_id = 0;
#endif
	DBTCL_INFO *ip;
	DB_ENV *envp;
	Tcl_Obj *res;
	int cmdindex, result;
	char newname[MSG_SIZE];

	COMPQUIET(notused, NULL);

	Tcl_ResetResult(interp);
	memset(newname, 0, MSG_SIZE);
	result = TCL_OK;
	if (objc <= 1) {
		Tcl_WrongNumArgs(interp, 1, objv, "command cmdargs");
		return (TCL_ERROR);
	}

	/*
	 * Get the command name index from the object based on the berkdbcmds
	 * defined above.
	 */
	if (Tcl_GetIndexFromObj(interp,
	    objv[1], berkdbcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
		return (IS_HELP(objv[1]));
	res = NULL;
	switch ((enum berkdbcmds)cmdindex) {
#if CONFIG_TEST
	case BDB_DBVERIFY:
		result = bdb_DbVerify(interp, objc, objv);
		break;
	case BDB_HANDLES:
		result = bdb_Handles(interp, objc, objv);
		break;
	case BDB_UPGRADE:
		result = bdb_DbUpgrade(interp, objc, objv);
		break;
#endif
	case BDB_VERSION:
		_debug_check();
		result = bdb_Version(interp, objc, objv);
		break;
	case BDB_ENV:
		snprintf(newname, sizeof(newname), "env%d", env_id);
		ip = _NewInfo(interp, NULL, newname, I_ENV);
		if (ip != NULL) {
			result = bdb_EnvOpen(interp, objc, objv, ip, &envp);
			if (result == TCL_OK && envp != NULL) {
				env_id++;
				Tcl_CreateObjCommand(interp, newname,
				    (Tcl_ObjCmdProc *)env_Cmd,
				    (ClientData)envp, NULL);
				/* Use ip->i_name - newname is overwritten */
				res =
				    Tcl_NewStringObj(newname, strlen(newname));
				_SetInfoData(ip, envp);
			} else
				_DeleteInfo(ip);
		} else {
			Tcl_SetResult(interp, "Could not set up info",
			    TCL_STATIC);
			result = TCL_ERROR;
		}
		break;
	case BDB_DBREMOVE:
		result = bdb_DbRemove(interp, objc, objv);
		break;
	case BDB_DBRENAME:
		result = bdb_DbRename(interp, objc, objv);
		break;
	case BDB_ENVREMOVE:
		result = tcl_EnvRemove(interp, objc, objv, NULL, NULL);
		break;
	case BDB_OPEN:
		snprintf(newname, sizeof(newname), "db%d", db_id);
		ip = _NewInfo(interp, NULL, newname, I_DB);
		if (ip != NULL) {
			result = bdb_DbOpen(interp, objc, objv, ip, &dbp);
			if (result == TCL_OK && dbp != NULL) {
				db_id++;
				Tcl_CreateObjCommand(interp, newname,
				    (Tcl_ObjCmdProc *)db_Cmd,
				    (ClientData)dbp, NULL);
				/* Use ip->i_name - newname is overwritten */
				res =
				    Tcl_NewStringObj(newname, strlen(newname));
				_SetInfoData(ip, dbp);
			} else
				_DeleteInfo(ip);
		} else {
			Tcl_SetResult(interp, "Could not set up info",
			    TCL_STATIC);
			result = TCL_ERROR;
		}
		break;
#if CONFIG_TEST
	case BDB_HCREATEX:
	case BDB_HSEARCHX:
	case BDB_HDESTROYX:
		result = bdb_HCommand(interp, objc, objv);
		break;
	case BDB_DBMINITX:
	case BDB_DBMCLOSEX:
	case BDB_FETCHX:
	case BDB_STOREX:
	case BDB_DELETEX:
	case BDB_FIRSTKEYX:
	case BDB_NEXTKEYX:
		result = bdb_DbmCommand(interp, objc, objv, DBTCL_DBM, NULL);
		break;
	case BDB_NDBMOPENX:
		snprintf(newname, sizeof(newname), "ndbm%d", ndbm_id);
		ip = _NewInfo(interp, NULL, newname, I_NDBM);
		if (ip != NULL) {
			result = bdb_NdbmOpen(interp, objc, objv, &ndbmp);
			if (result == TCL_OK) {
				ndbm_id++;
				Tcl_CreateObjCommand(interp, newname,
				    (Tcl_ObjCmdProc *)ndbm_Cmd,
				    (ClientData)ndbmp, NULL);
				/* Use ip->i_name - newname is overwritten */
				res =
				    Tcl_NewStringObj(newname, strlen(newname));
				_SetInfoData(ip, ndbmp);
			} else
				_DeleteInfo(ip);
		} else {
			Tcl_SetResult(interp, "Could not set up info",
			    TCL_STATIC);
			result = TCL_ERROR;
		}
		break;
#endif
	case BDB_RANDX:
	case BDB_RAND_INTX:
	case BDB_SRANDX:
		result = bdb_RandCommand(interp, objc, objv);
		break;
	case BDB_DBGCKX:
		_debug_check();
		res = Tcl_NewIntObj(0);
		break;
	}
	/*
	 * For each different arg call different function to create
	 * new commands (or if version, get/return it).
	 */
	if (result == TCL_OK && res != NULL)
		Tcl_SetObjResult(interp, res);
	return (result);
}

/*
 * bdb_EnvOpen -
 *	Implements the environment open command.
 *	There are many, many options to the open command.
 *	Here is the general flow:
 *
 *	1.  Call db_env_create to create the env handle.
 *	2.  Parse args tracking options.
 *	3.  Make any pre-open setup calls necessary.
 *	4.  Call DB_ENV->open to open the env.
 *	5.  Return env widget handle to user.
 */
static int
bdb_EnvOpen(interp, objc, objv, ip, env)
	Tcl_Interp *interp;		/* Interpreter */
	int objc;			/* How many arguments? */
	Tcl_Obj *CONST objv[];		/* The argument objects */
	DBTCL_INFO *ip;			/* Our internal info */
	DB_ENV **env;			/* Environment pointer */
{
	static char *envopen[] = {
#if CONFIG_TEST
		"-auto_commit",
		"-cdb",
		"-cdb_alldb",
		"-client_timeout",
		"-lock",
		"-lock_conflict",
		"-lock_detect",
		"-lock_max",
		"-lock_max_locks",
		"-lock_max_lockers",
		"-lock_max_objects",
		"-lock_timeout",
		"-log",
		"-log_buffer",
		"-log_max",
		"-log_regionmax",
		"-mmapsize",
		"-nommap",
		"-overwrite",
		"-region_init",
		"-rep_client",
		"-rep_logsonly",
		"-rep_master",
		"-rep_transport",
		"-server",
		"-server_timeout",
		"-txn_timeout",
		"-txn_timestamp",
		"-verbose",
		"-wrnosync",
#endif
		"-cachesize",
		"-create",
		"-data_dir",
		"-encryptaes",
		"-encryptany",
		"-errfile",
		"-errpfx",
		"-home",
		"-log_dir",
		"-mode",
		"-private",
		"-recover",
		"-recover_fatal",
		"-shm_key",
		"-system_mem",
		"-tmp_dir",
		"-txn",
		"-txn_max",
		"-use_environ",
		"-use_environ_root",
		NULL
	};
	/*
	 * !!!
	 * These have to be in the same order as the above,
	 * which is close to but not quite alphabetical.
	 */
	enum envopen {
#if CONFIG_TEST
		ENV_AUTO_COMMIT,
		ENV_CDB,
		ENV_CDB_ALLDB,
		ENV_CLIENT_TO,
		ENV_LOCK,
		ENV_CONFLICT,
		ENV_DETECT,
		ENV_LOCK_MAX,
		ENV_LOCK_MAX_LOCKS,
		ENV_LOCK_MAX_LOCKERS,
		ENV_LOCK_MAX_OBJECTS,
		ENV_LOCK_TIMEOUT,
		ENV_LOG,
		ENV_LOG_BUFFER,
		ENV_LOG_MAX,
		ENV_LOG_REGIONMAX,
		ENV_MMAPSIZE,
		ENV_NOMMAP,
		ENV_OVERWRITE,
		ENV_REGION_INIT,
		ENV_REP_CLIENT,
		ENV_REP_LOGSONLY,
		ENV_REP_MASTER,
		ENV_REP_TRANSPORT,
		ENV_SERVER,
		ENV_SERVER_TO,
		ENV_TXN_TIMEOUT,
		ENV_TXN_TIME,
		ENV_VERBOSE,
		ENV_WRNOSYNC,
#endif
		ENV_CACHESIZE,
		ENV_CREATE,
		ENV_DATA_DIR,
		ENV_ENCRYPT_AES,
		ENV_ENCRYPT_ANY,
		ENV_ERRFILE,
		ENV_ERRPFX,
		ENV_HOME,
		ENV_LOG_DIR,
		ENV_MODE,
		ENV_PRIVATE,
		ENV_RECOVER,
		ENV_RECOVER_FATAL,
		ENV_SHM_KEY,
		ENV_SYSTEM_MEM,
		ENV_TMP_DIR,
		ENV_TXN,
		ENV_TXN_MAX,
		ENV_USE_ENVIRON,
		ENV_USE_ENVIRON_ROOT
	};
	Tcl_Obj **myobjv, **myobjv1;
	time_t timestamp;
	u_int32_t detect, gbytes, bytes, ncaches, logbufset, logmaxset;
	u_int32_t open_flags, rep_flags, set_flags, size, uintarg;
	u_int8_t *conflicts;
	int i, intarg, j, mode, myobjc, nmodes, optindex;
	int result, ret, temp;
	long client_to, server_to, shm;
	char *arg, *home, *passwd, *server;

	result = TCL_OK;
	mode = 0;
	rep_flags = set_flags = 0;
	home = NULL;

	/*
	 * XXX
	 * If/when our Tcl interface becomes thread-safe, we should enable
	 * DB_THREAD here in all cases.  For now, turn it on only when testing
	 * so that we exercise MUTEX_THREAD_LOCK cases.
	 *
	 * Historically, a key stumbling block was the log_get interface,
	 * which could only do relative operations in a non-threaded
	 * environment.  This is no longer an issue, thanks to log cursors,
	 * but we need to look at making sure DBTCL_INFO structs
	 * are safe to share across threads (they're not mutex-protected)
	 * before we declare the Tcl interface thread-safe.  Meanwhile,
	 * there's no strong reason to enable DB_THREAD.
	 */
	open_flags = DB_JOINENV |
#ifdef TEST_THREAD
	    DB_THREAD;
#else
	    0;
#endif
	logmaxset = logbufset = 0;

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

	/*
	 * Server code must go before the call to db_env_create.
	 */
	server = NULL;
	server_to = client_to = 0;
	i = 2;
	while (i < objc) {
		if (Tcl_GetIndexFromObj(interp, objv[i++], envopen, "option",
		    TCL_EXACT, &optindex) != TCL_OK) {
			Tcl_ResetResult(interp);
			continue;
		}
		switch ((enum envopen)optindex) {
#if CONFIG_TEST
		case ENV_SERVER:
			if (i >= objc) {
				Tcl_WrongNumArgs(interp, 2, objv,
				    "?-server hostname");
				result = TCL_ERROR;
				break;
			}
			server = Tcl_GetStringFromObj(objv[i++], NULL);
			break;
		case ENV_SERVER_TO:
			if (i >= objc) {
				Tcl_WrongNumArgs(interp, 2, objv,
				    "?-server_to secs");
				result = TCL_ERROR;
				break;
			}
			result = Tcl_GetLongFromObj(interp, objv[i++],
			    &server_to);
			break;
		case ENV_CLIENT_TO: