Logo Search packages:      
Sourcecode: db3 version File versions  Download package

tcl_env.c

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

#include "db_config.h"

#ifndef lint
static const char revid[] = "$Id: tcl_env.c,v 11.33 2001/01/11 18:19:55 bostic Exp $";
#endif /* not lint */

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

#include <stdlib.h>
#include <tcl.h>
#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 *));

/*
 * 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_get",
            "lock_stat",
            "lock_vec",
            "log_archive",
            "log_compare",
            "log_file",
            "log_flush",
            "log_get",
            "log_put",
            "log_register",
            "log_stat",
            "log_unregister",
            "mpool",
            "mpool_stat",
            "mpool_sync",
            "mpool_trickle",
            "mutex",
#if   CONFIG_TEST
            "test",
#endif
            "txn",
            "txn_checkpoint",
            "txn_stat",
            "verbose",
            NULL
      };
      enum envcmds {
            ENVCLOSE,
            ENVLKDETECT,
            ENVLKID,
            ENVLKGET,
            ENVLKSTAT,
            ENVLKVEC,
            ENVLOGARCH,
            ENVLOGCMP,
            ENVLOGFILE,
            ENVLOGFLUSH,
            ENVLOGGET,
            ENVLOGPUT,
            ENVLOGREG,
            ENVLOGSTAT,
            ENVLOGUNREG,
            ENVMP,
            ENVMPSTAT,
            ENVMPSYNC,
            ENVTRICKLE,
            ENVMUTEX,
#if   CONFIG_TEST
            ENVTEST,
#endif
            ENVTXN,
            ENVTXNCKP,
            ENVTXNSTAT,
            ENVVERB
      };
      DBTCL_INFO *envip;
      DB_ENV *envp;
      Tcl_Obj *res;
      u_int32_t newval;
      int cmdindex, result, ret;

      Tcl_ResetResult(interp);
      envp = (DB_ENV *)clientData;
      envip = _PtrToInfo((void *)envp);
      result = TCL_OK;

      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.
             */
            _EnvInfoDelete(interp, envip);
            envip = NULL;
            _debug_check();
            ret = envp->close(envp, 0);
            result = _ReturnSetup(interp, ret, "env close");
            break;
      case ENVLKDETECT:
            result = tcl_LockDetect(interp, objc, objv, envp);
            break;
      case ENVLKSTAT:
            result = tcl_LockStat(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 = lock_id(envp, &newval);
            result = _ReturnSetup(interp, ret, "lock_id");
            if (result == TCL_OK)
                  res = Tcl_NewIntObj((int)newval);
            break;
      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 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 ENVTXNCKP:
            result = tcl_TxnCheckpoint(interp, objc, objv, envp);
            break;
      case ENVTXNSTAT:
            result = tcl_TxnStat(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_server(e, server, 0, 0, 0);
                  result = _ReturnSetup(interp, ret, "set_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.
       * 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.
             */
             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",
            "preopen",
            "prerename",
            "postlog",
            "postlogmeta",
            "postopen",
            "postrename",
            "postsync",
            NULL
      };
      enum envtestat {
            ENVTEST_NONE,
            ENVTEST_PREOPEN,
            ENVTEST_PRERENAME,
            ENVTEST_POSTLOG,
            ENVTEST_POSTLOGMETA,
            ENVTEST_POSTOPEN,
            ENVTEST_POSTRENAME,
            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_PRERENAME:
            testval = DB_TEST_PRERENAME;
            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_POSTRENAME:
            testval = DB_TEST_POSTRENAME;
            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

Generated by  Doxygen 1.6.0   Back to index