/*- * See the file LICENSE for redistribution information. * * Copyright (c) 1999-2001 * Sleepycat Software. All rights reserved. */ #include "db_config.h" #ifndef lint static const char revid[] = "$Id: tcl_env.c,v 11.56 2001/11/16 16:19:54 bostic Exp $"; #endif /* not lint */ #ifndef NO_SYSTEM_INCLUDES #include #include #include #include #endif #include "db_int.h" #include "tcl_db.h" /* * Prototypes for procedures defined later in this file: */ static void _EnvInfoDelete __P((Tcl_Interp *, DBTCL_INFO *)); /* XXX These should really go in a new tcl_rep.c. */ static int tcl_RepElect __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *)); static int tcl_RepProcessMessage __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *)); /* * PUBLIC: int env_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*)); * * env_Cmd -- * Implements the "env" command. */ int env_Cmd(clientData, interp, objc, objv) ClientData clientData; /* Env handle */ Tcl_Interp *interp; /* Interpreter */ int objc; /* How many arguments? */ Tcl_Obj *CONST objv[]; /* The argument objects */ { static char *envcmds[] = { "close", "lock_detect", "lock_id", "lock_id_free", #if CONFIG_TEST "lock_id_set", #endif "lock_get", "lock_stat", "lock_timeout", "lock_vec", "log_archive", "log_compare", "log_cursor", "log_file", "log_flush", "log_get", "log_put", "log_register", "log_stat", "log_unregister", "mpool", "mpool_stat", "mpool_sync", "mpool_trickle", "mutex", "rep_elect", "rep_process_message", #if CONFIG_TEST "test", #endif "txn", "txn_checkpoint", #if CONFIG_TEST "txn_id_set", #endif "txn_recover", "txn_stat", "txn_timeout", "verbose", NULL }; enum envcmds { ENVCLOSE, ENVLKDETECT, ENVLKID, ENVLKFREEID, #if CONFIG_TEST ENVLKSETID, #endif ENVLKGET, ENVLKSTAT, ENVLKTIMEOUT, ENVLKVEC, ENVLOGARCH, ENVLOGCMP, ENVLOGCURSOR, ENVLOGFILE, ENVLOGFLUSH, ENVLOGGET, ENVLOGPUT, ENVLOGREG, ENVLOGSTAT, ENVLOGUNREG, ENVMP, ENVMPSTAT, ENVMPSYNC, ENVTRICKLE, ENVMUTEX, ENVREPELECT, ENVREPPROCMESS, #if CONFIG_TEST ENVTEST, #endif ENVTXN, ENVTXNCKP, #if CONFIG_TEST ENVTXNSETID, #endif ENVTXNRECOVER, ENVTXNSTAT, ENVTXNTIMEOUT, ENVVERB }; DBTCL_INFO *envip, *logcip; DB_ENV *envp; DB_LOGC *logc; Tcl_Obj *res; char newname[MSG_SIZE]; int cmdindex, result, ret; u_int32_t newval; #if CONFIG_TEST u_int32_t otherval; #endif Tcl_ResetResult(interp); envp = (DB_ENV *)clientData; envip = _PtrToInfo((void *)envp); result = TCL_OK; memset(newname, 0, MSG_SIZE); if (objc <= 1) { Tcl_WrongNumArgs(interp, 1, objv, "command cmdargs"); return (TCL_ERROR); } if (envp == NULL) { Tcl_SetResult(interp, "NULL env pointer", TCL_STATIC); return (TCL_ERROR); } if (envip == NULL) { Tcl_SetResult(interp, "NULL env info pointer", TCL_STATIC); return (TCL_ERROR); } /* * Get the command name index from the object based on the berkdbcmds * defined above. */ if (Tcl_GetIndexFromObj(interp, objv[1], envcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK) return (IS_HELP(objv[1])); res = NULL; switch ((enum envcmds)cmdindex) { case ENVCLOSE: /* * No args for this. Error if there are some. */ if (objc > 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return (TCL_ERROR); } /* * Any transactions will be aborted, and an mpools * closed automatically. We must delete any txn * and mp widgets we have here too for this env. * NOTE: envip is freed when we come back from * this function. Set it to NULL to make sure no * one tries to use it later. */ _debug_check(); ret = envp->close(envp, 0); result = _ReturnSetup(interp, ret, "env close"); _EnvInfoDelete(interp, envip); envip = NULL; break; case ENVLKDETECT: result = tcl_LockDetect(interp, objc, objv, envp); break; case ENVLKSTAT: result = tcl_LockStat(interp, objc, objv, envp); break; case ENVLKTIMEOUT: result = tcl_LockTimeout(interp, objc, objv, envp); break; case ENVLKID: /* * No args for this. Error if there are some. */ if (objc > 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return (TCL_ERROR); } _debug_check(); ret = envp->lock_id(envp, &newval); result = _ReturnSetup(interp, ret, "lock_id"); if (result == TCL_OK) res = Tcl_NewLongObj((long)newval); break; case ENVLKFREEID: if (objc != 3) { Tcl_WrongNumArgs(interp, 3, objv, NULL); return (TCL_ERROR); } result = Tcl_GetLongFromObj(interp, objv[2], (long *)&newval); if (result != TCL_OK) return (result); ret = envp->lock_id_free(envp, newval); result = _ReturnSetup(interp, ret, "lock id_free"); break; #if CONFIG_TEST case ENVLKSETID: if (objc != 4) { Tcl_WrongNumArgs(interp, 4, objv, "current max"); return (TCL_ERROR); } result = Tcl_GetLongFromObj(interp, objv[2], (long *)&newval); if (result != TCL_OK) return (result); result = Tcl_GetLongFromObj(interp, objv[3], (long *)&otherval); if (result != TCL_OK) return (result); ret = envp->lock_id_set(envp, newval, otherval); result = _ReturnSetup(interp, ret, "lock id_free"); break; #endif case ENVLKGET: result = tcl_LockGet(interp, objc, objv, envp); break; case ENVLKVEC: result = tcl_LockVec(interp, objc, objv, envp); break; case ENVLOGARCH: result = tcl_LogArchive(interp, objc, objv, envp); break; case ENVLOGCMP: result = tcl_LogCompare(interp, objc, objv); break; case ENVLOGCURSOR: snprintf(newname, sizeof(newname), "%s.logc%d", envip->i_name, envip->i_envlogcid); logcip = _NewInfo(interp, NULL, newname, I_LOGC); if (logcip != NULL) { ret = envp->log_cursor(envp, &logc, 0); if (ret == 0) { result = TCL_OK; envip->i_envlogcid++; /* * We do NOT want to set i_parent to * envip here because log cursors are * not "tied" to the env. That is, they * are NOT closed if the env is closed. */ Tcl_CreateObjCommand(interp, newname, (Tcl_ObjCmdProc *)logc_Cmd, (ClientData)logc, NULL); res = Tcl_NewStringObj(newname, strlen(newname)); _SetInfoData(logcip, logc); } else { _DeleteInfo(logcip); result = _ErrorSetup(interp, ret, "log cursor"); } } else { Tcl_SetResult(interp, "Could not set up info", TCL_STATIC); result = TCL_ERROR; } break; case ENVLOGFILE: result = tcl_LogFile(interp, objc, objv, envp); break; case ENVLOGFLUSH: result = tcl_LogFlush(interp, objc, objv, envp); break; case ENVLOGGET: result = tcl_LogGet(interp, objc, objv, envp); break; case ENVLOGPUT: result = tcl_LogPut(interp, objc, objv, envp); break; case ENVLOGREG: result = tcl_LogRegister(interp, objc, objv, envp); break; case ENVLOGUNREG: result = tcl_LogUnregister(interp, objc, objv, envp); break; case ENVLOGSTAT: result = tcl_LogStat(interp, objc, objv, envp); break; case ENVMPSTAT: result = tcl_MpStat(interp, objc, objv, envp); break; case ENVMPSYNC: result = tcl_MpSync(interp, objc, objv, envp); break; case ENVTRICKLE: result = tcl_MpTrickle(interp, objc, objv, envp); break; case ENVMP: result = tcl_Mp(interp, objc, objv, envp, envip); break; case ENVREPELECT: result = tcl_RepElect(interp, objc, objv, envp); break; case ENVREPPROCMESS: result = tcl_RepProcessMessage(interp, objc, objv, envp); break; case ENVTXNCKP: result = tcl_TxnCheckpoint(interp, objc, objv, envp); break; #if CONFIG_TEST case ENVTXNSETID: if (objc != 4) { Tcl_WrongNumArgs(interp, 4, objv, "current max"); return (TCL_ERROR); } result = Tcl_GetLongFromObj(interp, objv[2], (long *)&newval); if (result != TCL_OK) return (result); result = Tcl_GetLongFromObj(interp, objv[3], (long *)&otherval); if (result != TCL_OK) return (result); ret = envp->txn_id_set(envp, newval, otherval); result = _ReturnSetup(interp, ret, "lock id_free"); break; #endif case ENVTXNRECOVER: result = tcl_TxnRecover(interp, objc, objv, envp, envip); break; case ENVTXNSTAT: result = tcl_TxnStat(interp, objc, objv, envp); break; case ENVTXNTIMEOUT: result = tcl_TxnTimeout(interp, objc, objv, envp); break; case ENVTXN: result = tcl_Txn(interp, objc, objv, envp, envip); break; case ENVMUTEX: result = tcl_Mutex(interp, objc, objv, envp, envip); break; #if CONFIG_TEST case ENVTEST: result = tcl_EnvTest(interp, objc, objv, envp); break; #endif case ENVVERB: /* * Two args for this. Error if different. */ if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return (TCL_ERROR); } result = tcl_EnvVerbose(interp, envp, objv[2], objv[3]); break; } /* * Only set result if we have a res. Otherwise, lower * functions have already done so. */ if (result == TCL_OK && res) Tcl_SetObjResult(interp, res); return (result); } /* * PUBLIC: int tcl_EnvRemove __P((Tcl_Interp *, int, Tcl_Obj * CONST*, * PUBLIC: DB_ENV *, DBTCL_INFO *)); * * tcl_EnvRemove -- */ int tcl_EnvRemove(interp, objc, objv, envp, envip) Tcl_Interp *interp; /* Interpreter */ int objc; /* How many arguments? */ Tcl_Obj *CONST objv[]; /* The argument objects */ DB_ENV *envp; /* Env pointer */ DBTCL_INFO *envip; /* Info pointer */ { static char *envremopts[] = { "-data_dir", "-force", "-home", "-log_dir", "-server", "-tmp_dir", "-use_environ", "-use_environ_root", NULL }; enum envremopts { ENVREM_DATADIR, ENVREM_FORCE, ENVREM_HOME, ENVREM_LOGDIR, ENVREM_SERVER, ENVREM_TMPDIR, ENVREM_USE_ENVIRON, ENVREM_USE_ENVIRON_ROOT }; DB_ENV *e; u_int32_t cflag, flag, forceflag; int i, optindex, result, ret; char *datadir, *home, *logdir, *server, *tmpdir; result = TCL_OK; cflag = flag = forceflag = 0; home = NULL; datadir = logdir = tmpdir = NULL; server = NULL; if (objc < 2) { Tcl_WrongNumArgs(interp, 2, objv, "?args?"); return (TCL_ERROR); } i = 2; while (i < objc) { if (Tcl_GetIndexFromObj(interp, objv[i], envremopts, "option", TCL_EXACT, &optindex) != TCL_OK) { result = IS_HELP(objv[i]); goto error; } i++; switch ((enum envremopts)optindex) { case ENVREM_FORCE: forceflag |= DB_FORCE; break; case ENVREM_HOME: /* Make sure we have an arg to check against! */ if (i >= objc) { Tcl_WrongNumArgs(interp, 2, objv, "?-home dir?"); result = TCL_ERROR; break; } home = Tcl_GetStringFromObj(objv[i++], NULL); break; case ENVREM_SERVER: /* Make sure we have an arg to check against! */ if (i >= objc) { Tcl_WrongNumArgs(interp, 2, objv, "?-server name?"); result = TCL_ERROR; break; } server = Tcl_GetStringFromObj(objv[i++], NULL); cflag = DB_CLIENT; break; case ENVREM_USE_ENVIRON: flag |= DB_USE_ENVIRON; break; case ENVREM_USE_ENVIRON_ROOT: flag |= DB_USE_ENVIRON_ROOT; break; case ENVREM_DATADIR: if (i >= objc) { Tcl_WrongNumArgs(interp, 2, objv, "-data_dir dir"); result = TCL_ERROR; break; } datadir = Tcl_GetStringFromObj(objv[i++], NULL); break; case ENVREM_LOGDIR: if (i >= objc) { Tcl_WrongNumArgs(interp, 2, objv, "-log_dir dir"); result = TCL_ERROR; break; } logdir = Tcl_GetStringFromObj(objv[i++], NULL); break; case ENVREM_TMPDIR: if (i >= objc) { Tcl_WrongNumArgs(interp, 2, objv, "-tmp_dir dir"); result = TCL_ERROR; break; } tmpdir = Tcl_GetStringFromObj(objv[i++], NULL); break; } /* * If, at any time, parsing the args we get an error, * bail out and return. */ if (result != TCL_OK) goto error; } /* * If envp is NULL, we don't have an open env and we need to open * one of the user. Don't bother with the info stuff. */ if (envp == NULL) { if ((ret = db_env_create(&e, cflag)) != 0) { result = _ReturnSetup(interp, ret, "db_env_create"); goto error; } if (server != NULL) { ret = e->set_rpc_server(e, NULL, server, 0, 0, 0); result = _ReturnSetup(interp, ret, "set_rpc_server"); if (result != TCL_OK) goto error; } if (datadir != NULL) { _debug_check(); ret = e->set_data_dir(e, datadir); result = _ReturnSetup(interp, ret, "set_data_dir"); if (result != TCL_OK) goto error; } if (logdir != NULL) { _debug_check(); ret = e->set_lg_dir(e, logdir); result = _ReturnSetup(interp, ret, "set_log_dir"); if (result != TCL_OK) goto error; } if (tmpdir != NULL) { _debug_check(); ret = e->set_tmp_dir(e, tmpdir); result = _ReturnSetup(interp, ret, "set_tmp_dir"); if (result != TCL_OK) goto error; } } else { /* * We have to clean up any info associated with this env, * regardless of the result of the remove so do it first. * NOTE: envip is freed when we come back from this function. */ _EnvInfoDelete(interp, envip); envip = NULL; e = envp; } flag |= forceflag; /* * When we get here we have parsed all the args. Now remove * the environment. */ _debug_check(); ret = e->remove(e, home, flag); result = _ReturnSetup(interp, 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); } /* * PUBLIC: int tcl_EnvVerbose __P((Tcl_Interp *, DB_ENV *, Tcl_Obj *, * PUBLIC: Tcl_Obj *)); * * tcl_EnvVerbose -- */ int tcl_EnvVerbose(interp, envp, which, onoff) Tcl_Interp *interp; /* Interpreter */ DB_ENV *envp; /* Env pointer */ Tcl_Obj *which; /* Which subsystem */ Tcl_Obj *onoff; /* On or off */ { static char *verbwhich[] = { "chkpt", "deadlock", "recovery", "wait", NULL }; enum verbwhich { ENVVERB_CHK, ENVVERB_DEAD, ENVVERB_REC, 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_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 = envp->set_verbose(envp, wh, on); return (_ReturnSetup(interp, ret, "env set verbose")); } #if CONFIG_TEST /* * PUBLIC: int tcl_EnvTest __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *)); * * tcl_EnvTest -- */ int tcl_EnvTest(interp, objc, objv, envp) Tcl_Interp *interp; /* Interpreter */ int objc; /* How many arguments? */ Tcl_Obj *CONST objv[]; /* The argument objects */ DB_ENV *envp; /* Env pointer */ { static char *envtestcmd[] = { "abort", "copy", NULL }; enum envtestcmd { ENVTEST_ABORT, ENVTEST_COPY }; static char *envtestat[] = { "none", "predestroy", "preopen", "postdestroy", "postlog", "postlogmeta", "postopen", "postsync", NULL }; enum envtestat { ENVTEST_NONE, ENVTEST_PREDESTROY, ENVTEST_PREOPEN, ENVTEST_POSTDESTROY, ENVTEST_POSTLOG, ENVTEST_POSTLOGMETA, ENVTEST_POSTOPEN, ENVTEST_POSTSYNC }; int *loc, optindex, result, testval; result = TCL_OK; 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 = &envp->test_abort; break; case ENVTEST_COPY: loc = &envp->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_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; default: Tcl_SetResult(interp, "Illegal test location", TCL_STATIC); return (TCL_ERROR); } *loc = testval; Tcl_SetResult(interp, "0", TCL_STATIC); return (result); } #endif /* * tcl_RepElect -- * Call DB_ENV->rep_elect(). */ int tcl_RepElect(interp, objc, objv, envp) Tcl_Interp *interp; /* Interpreter */ int objc; /* How many arguments? */ Tcl_Obj *CONST objv[]; /* The argument objects */ DB_ENV *envp; /* Environment pointer */ { int eid, nsites, pri, result, ret; u_int32_t timeout; if (objc != 5) { Tcl_WrongNumArgs(interp, 5, objv, "nsites pri timeout"); return (TCL_ERROR); } if ((result = Tcl_GetIntFromObj(interp, objv[2], &nsites)) != TCL_OK) return (result); if ((result = Tcl_GetIntFromObj(interp, objv[3], &pri)) != TCL_OK) return (result); if ((result = _GetUInt32(interp, objv[4], &timeout)) != TCL_OK) return (result); if ((ret = envp->rep_elect(envp, nsites, pri, timeout, &eid)) != 0) return (_ReturnSetup(interp, ret, "env rep_elect")); Tcl_SetObjResult(interp, Tcl_NewIntObj(eid)); return (TCL_OK); } /* * tcl_RepProcessMessage -- * Call DB_ENV->rep_process_message(). */ int tcl_RepProcessMessage(interp, objc, objv, envp) Tcl_Interp *interp; /* Interpreter */ int objc; /* How many arguments? */ Tcl_Obj *CONST objv[]; /* The argument objects */ DB_ENV *envp; /* Environment pointer */ { DBT rec, control; Tcl_Obj *res; int eid; int itmp, result, ret; if (objc != 5) { Tcl_WrongNumArgs(interp, 5, objv, "id rec control"); return (TCL_ERROR); } memset(&rec, 0, sizeof(rec)); memset(&control, 0, sizeof(control)); if ((result = Tcl_GetIntFromObj(interp, objv[2], &eid)) != TCL_OK) return (result); control.data = Tcl_GetByteArrayFromObj(objv[3], &itmp); control.size = itmp; rec.data = Tcl_GetByteArrayFromObj(objv[4], &itmp); rec.size = itmp; ret = envp->rep_process_message(envp, &rec, &control, &eid); result = _ReturnSetup(interp, ret, "env rep_process_message"); /* * If we have a new master, return its environment ID. * * XXX * We should do something prettier to differentiate success * from an env ID, and figure out how to represent HOLDELECTION. */ if (result == TCL_OK && ret == DB_REP_NEWMASTER) { res = Tcl_NewIntObj(eid); Tcl_SetObjResult(interp, res); } return (result); }