/*
 * cdb, cdb-wr - Tcl bindings for tinycdb and a journalling write extension
 * Copyright 2006-2012 Ian Jackson
 *
 * This program is free software; you can redistribute it and/or
 * modify it under the terms of the GNU General Public License as
 * published by the Free Software Foundation; either version 2 of the
 * License, or (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this library; if not, see <http://www.gnu.org/licenses/>.
 */

#include "chiark_tcl_cdb.h"

#define KEYLEN_MAX (INT_MAX/2)

#define ftello ftell
#define fseeko fseek

/*---------- Forward declarations ----------*/

struct ht_forall_ctx;

/*---------- Useful routines ----------*/

static void maybe_close(int fd) {
  if (fd>=0) close(fd);
}

/*==================== Subsystems and subtypes ====================*/

/*---------- Pathbuf ----------*/

typedef struct Pathbuf {
  char *buf, *sfx;
} Pathbuf;

#define MAX_SUFFIX 5

static void pathbuf_init(Pathbuf *pb, const char *pathb) {
  size_t l= strlen(pathb);
  assert(l < INT_MAX);
  pb->buf= TALLOC(l + MAX_SUFFIX + 1);
  memcpy(pb->buf, pathb, l);
  pb->sfx= pb->buf + l;
}
static const char *pathbuf_sfx(Pathbuf *pb, const char *suffix) {
  assert(strlen(suffix) <= MAX_SUFFIX);
  strcpy(pb->sfx, suffix);
  return pb->buf;
}
static void pathbuf_free(Pathbuf *pb) {
  TFREE(pb->buf);
  pb->buf= 0;
}

/*---------- Our hash table ----------*/

typedef struct HashTable {
  Tcl_HashTable t;
  Byte padding[128]; /* allow for expansion by Tcl, urgh */
  Byte confound[16];
} HashTable;

typedef struct HashValue {
  int len;
  Byte data[1];
} HashValue;

static HashValue *htv_prep(int len) {
  HashValue *hd;
  hd= TALLOC((hd->data - (Byte*)hd) + len);
  hd->len= len;
  return hd;
}  
static Byte *htv_fillptr(HashValue *hd) {
  return hd->data;
}

static void ht_setup(HashTable *ht) {
  Tcl_InitHashTable(&ht->t, TCL_STRING_KEYS);
}
static void ht_update(HashTable *ht, const char *key, HashValue *val_eat) {
  Tcl_HashEntry *he;
  int new;

  he= Tcl_CreateHashEntry(&ht->t, (char*)key, &new);
  if (!new) TFREE(Tcl_GetHashValue(he));
  Tcl_SetHashValue(he, val_eat);
    /* eats the value since the data structure owns the memory */
}
static void ht_maybeupdate(HashTable *ht, const char *key,
			   HashValue *val_eat) {
  /* like ht_update except does not overwrite existing values */
  Tcl_HashEntry *he;
  int new;

  he= Tcl_CreateHashEntry(&ht->t, (char*)key, &new);
  if (!new) { TFREE(val_eat); return; }
  Tcl_SetHashValue(he, val_eat);
}

static const HashValue *ht_lookup(HashTable *ht, const char *key) {
  Tcl_HashEntry *he;
  
  he= Tcl_FindHashEntry(&ht->t, key);
  if (!he) return 0;
  
  return Tcl_GetHashValue(he);
}

static int ht_forall(HashTable *ht,
		     int (*fn)(const char *key, HashValue *val,
			       struct ht_forall_ctx *ctx),
		     struct ht_forall_ctx *ctx) {
  /* Returns first positive value returned by any call to fn, or 0. */
  Tcl_HashSearch sp;
  Tcl_HashEntry *he;
  const char *key;
  HashValue *val;
  int r;
  
  for (he= Tcl_FirstHashEntry(&ht->t, &sp);
       he;
       he= Tcl_NextHashEntry(&sp)) {
    val= Tcl_GetHashValue(he);
    if (!val->len) continue;

    key= Tcl_GetHashKey(&ht->t, he);
    
    r= fn(key, val, ctx);
    if (r) return r;
  }
  return 0;
}

static void ht_destroy(HashTable *ht) {
  Tcl_HashSearch sp;
  Tcl_HashEntry *he;
  
  for (he= Tcl_FirstHashEntry(&ht->t, &sp);
       he;
       he= Tcl_NextHashEntry(&sp)) {
    /* ht_forall skips empty (deleted) entries so is no good for this */
    TFREE(Tcl_GetHashValue(he));
  }
  Tcl_DeleteHashTable(&ht->t);
}

/*==================== Existential ====================*/

/*---------- Rw data structure ----------*/

typedef struct Rw {
  int ix, autocompact;
  int cdb_fd, lock_fd;
  struct cdb cdb; /* valid iff cdb_fd >= 0 */
  FILE *logfile; /* may be 0; if so, is broken */
  HashTable logincore;
  Pathbuf pbsome, pbother;
  off_t mainsz;
  ScriptToInvoke on_info, on_lexminval;
} Rw;

static void rw_cdb_close(Tcl_Interp *ip, Rw *rw) {
  if (rw->cdb_fd >= 0) cdb_free(&rw->cdb);
  maybe_close(rw->cdb_fd);
}

static int rw_close(Tcl_Interp *ip, Rw *rw) {
  int rc, r;

  rc= TCL_OK;
  ht_destroy(&rw->logincore);
  rw_cdb_close(ip,rw);
  maybe_close(rw->lock_fd);

  if (rw->logfile) {
    r= fclose(rw->logfile);
    if (r && ip) { rc= cht_posixerr(ip, errno, "probable data loss! failed to"
				    " fclose logfile during untidy close"); }
  }

  pathbuf_free(&rw->pbsome); pathbuf_free(&rw->pbother);
  return rc;
}

static void destroy_cdbrw_idtabcb(Tcl_Interp *ip, void *rw_v) {
  rw_close(0,rw_v);
  TFREE(rw_v);
}
const IdDataSpec cdbtcl_rwdatabases= {
  "cdb-rwdb", "cdb-openrwdatabases-table", destroy_cdbrw_idtabcb
};

/*---------- File handling ----------*/

static int acquire_lock(Tcl_Interp *ip, Pathbuf *pb, int *lockfd_r) {
  /* *lockfd_r must be -1 on entry.  If may be set to >=0 even
   * on error, and must be closed by the caller. */
  mode_t um, lockmode;
  struct flock fl;
  int r;

  um= umask(~(mode_t)0);
  umask(um);

  lockmode= 0666 & ~((um & 0444)>>1);
  /* Remove r where umask would remove w;
   * eg umask intending 0664 here gives 0660 */
  
  *lockfd_r= open(pathbuf_sfx(pb,".lock"), O_RDWR|O_CREAT, lockmode);
  if (*lockfd_r < 0)
    return cht_posixerr(ip, errno, "could not open/create lockfile");

  fl.l_type= F_WRLCK;
  fl.l_whence= SEEK_SET;
  fl.l_start= 0;
  fl.l_len= 0;
  fl.l_pid= getpid();

  r= fcntl(*lockfd_r, F_SETLK, &fl);
  if (r == -1) {
    if (errno == EACCES || errno == EAGAIN)
      return cht_staticerr(ip, "lock held by another process", "CDB LOCKED");
    else return cht_posixerr(ip, errno, "unexpected error from fcntl while"
			     " acquiring lock");
  }

  return TCL_OK;
}

/*---------- Log reading and writing ----------*/

static int readlognum(FILE *f, int delim, int *num_r) {
  int c;
  char numbuf[20], *p, *ep;
  unsigned long ul;

  p= numbuf;
  for (;;) {
    c= getc(f);  if (c==EOF) return -2;
    if (c == delim) break;
    if (!isdigit((unsigned char)c)) return -2;
    *p++= c;
    if (p == numbuf+sizeof(numbuf)) return -2;
  }
  if (p == numbuf) return -2;
  *p= 0;

  errno=0; ul= strtoul(numbuf, &ep, 10);
  if (*ep || errno || ul >= KEYLEN_MAX) return -2;
  *num_r= ul;
  return 0;
}

static int readstorelogrecord(FILE *f, HashTable *ht,
			      int (*omitfn)(const HashValue*,
					    struct ht_forall_ctx *ctx),
			      struct ht_forall_ctx *ctx,
			      void (*updatefn)(HashTable*, const char*,
					       HashValue*)) {
  /* returns:
   *      0     for OK
   *     -1     eof
   *     -2     corrupt or error
   *     -3     got newline indicating end
   *     >0     value from omitfn
   */
  int keylen, vallen;
  char *key;
  HashValue *val;
  int c, rc, r;

  c= getc(f);
  if (c==EOF) { return feof(f) ? -1 : -2; }
  if (c=='\n') return -3;
  if (c!='+') return -2;

  rc= readlognum(f, ',', &keylen);  if (rc) return rc;
  rc= readlognum(f, ':', &vallen);  if (rc) return rc;

  key= TALLOC(keylen+1);
  val= htv_prep(vallen);

  r= fread(key, 1,keylen, f);
  if (r!=keylen) goto x2_free_keyval;
  if (memchr(key,0,keylen)) goto x2_free_keyval;
  key[keylen]= 0;

  c= getc(f);  if (c!='-') goto x2_free_keyval;
  c= getc(f);  if (c!='>') goto x2_free_keyval;
  
  r= fread(htv_fillptr(val), 1,vallen, f);
  if (r!=vallen) goto x2_free_keyval;

  c= getc(f);  if (c!='\n') goto x2_free_keyval;

  rc= omitfn ? omitfn(val, ctx) : TCL_OK;
  if (rc) { assert(rc>0); TFREE(val); }
  else updatefn(ht, key, val);
  
  TFREE(key);
  return rc;

 x2_free_keyval:
  TFREE(val);
  TFREE(key);
  return -2;
}

static int writerecord(FILE *f, const char *key, const HashValue *val) {
  int r;

  r= fprintf(f, "+%d,%d:%s->", (int)strlen(key), val->len, key);
  if (r<0) return -1;
  
  r= fwrite(val->data, 1, val->len, f);
  if (r != val->len) return -1;

  r= putc('\n', f);
  if (r==EOF) return -1;

  return 0;
}

/*---------- Creating ----------*/

int cht_do_cdbwr_create_empty(ClientData cd, Tcl_Interp *ip,
			      const char *pathb) {
  static const char *const toremoves[]= { ".cdb", ".jrn", ".tmp", 0 };

  Pathbuf pb, pbmain;
  int lock_fd=-1, rc, r;
  FILE *f= 0;
  const char *const *toremove;
  struct stat stab;

  pathbuf_init(&pb, pathb);
  pathbuf_init(&pbmain, pathb);

  rc= acquire_lock(ip, &pb, &lock_fd);  if (rc) goto x_rc;

  r= lstat(pathbuf_sfx(&pbmain, ".main"), &stab);
  if (!r) { rc= cht_staticerr(ip, "database already exists during creation",
			      "CDB ALREADY-EXISTS");  goto x_rc; }
  if (errno != ENOENT) PE("check for existing database .main during creation");

  for (toremove=toremoves; *toremove; toremove++) {
    r= remove(pathbuf_sfx(&pb, *toremove));
    if (r && errno != ENOENT)
      PE("delete possible spurious file during creation");
  }
  
  f= fopen(pathbuf_sfx(&pb, ".tmp"), "w");
  if (!f) PE("create new database .tmp");  
  r= putc('\n', f);  if (r==EOF) PE("write sentinel to new database .tmp");
  r= fclose(f);  f=0;  if (r) PE("close new database .tmp during creation");

  r= rename(pb.buf, pbmain.buf);
  if (r) PE("install new database .tmp as .main (finalising creation)");
  
  rc= TCL_OK;

 x_rc:
  if (f) fclose(f);
  maybe_close(lock_fd);
  pathbuf_free(&pb);
  pathbuf_free(&pbmain);
  return rc;
}

/*---------- Info callbacks ----------*/

static int infocbv3(Tcl_Interp *ip, Rw *rw, const char *arg1,
		    const char *arg2fmt, const char *arg3, va_list al) {
  Tcl_Obj *aa[3];
  int na;
  char buf[200];
  vsnprintf(buf, sizeof(buf), arg2fmt, al);

  na= 0;
  aa[na++]= cht_ret_string(ip, arg1);
  aa[na++]= cht_ret_string(ip, buf);
  if (arg3) aa[na++]= cht_ret_string(ip, arg3);
  
  return cht_scriptinv_invoke_fg(&rw->on_info, na, aa);
}
  
static int infocb3(Tcl_Interp *ip, Rw *rw, const char *arg1,
		   const char *arg2fmt, const char *arg3, ...) {
  int rc;
  va_list al;
  va_start(al, arg3);
  rc= infocbv3(ip,rw,arg1,arg2fmt,arg3,al);
  va_end(al);
  return rc;
}
  
static int infocb(Tcl_Interp *ip, Rw *rw, const char *arg1,
		  const char *arg2fmt, ...) {
  int rc;
  va_list al;
  va_start(al, arg2fmt);
  rc= infocbv3(ip,rw,arg1,arg2fmt,0,al);
  va_end(al);
  return rc;
}
  
/*---------- Opening ----------*/

static int cdbinit(Tcl_Interp *ip, Rw *rw) {
  /* On entry, cdb_fd >=0 but cdb is _undefined_
   * On exit, either cdb_fd<0 or cdb is initialised */
  int r, rc;
  
  r= cdb_init(&rw->cdb, rw->cdb_fd);
  if (r) {
    rc= cht_posixerr(ip, errno, "failed to initialise cdb reader");
    close(rw->cdb_fd);  rw->cdb_fd= -1;  return rc;
  }
  return TCL_OK;
}

int cht_do_cdbwr_open(ClientData cd, Tcl_Interp *ip, const char *pathb,
		      Tcl_Obj *on_info, Tcl_Obj *on_lexminval,
		      void **result) {
  const Cdbwr_SubCommand *subcmd= cd;
  int r, rc, mainfd=-1;
  Rw *rw;
  struct stat stab;
  off_t logrecstart, logjunkpos;

  rw= TALLOC(sizeof(*rw));
  rw->ix= -1;
  ht_setup(&rw->logincore);
  cht_scriptinv_init(&rw->on_info);
  cht_scriptinv_init(&rw->on_lexminval);
  rw->cdb_fd= rw->lock_fd= -1;  rw->logfile= 0;
  pathbuf_init(&rw->pbsome, pathb);
  pathbuf_init(&rw->pbother, pathb);
  rw->autocompact= 1;

  rc= cht_scriptinv_set(&rw->on_info, ip, on_info, 0);
  if (rc) goto x_rc;

  rc= cht_scriptinv_set(&rw->on_lexminval, ip, on_lexminval, 0);
  if (rc) goto x_rc;

  mainfd= open(pathbuf_sfx(&rw->pbsome,".main"), O_RDONLY);
  if (mainfd<0) PE("open existing database file .main");
  rc= acquire_lock(ip, &rw->pbsome, &rw->lock_fd);  if (rc) goto x_rc;

  r= fstat(mainfd, &stab);  if (r) PE("fstat .main");
  rw->mainsz= stab.st_size;

  rw->cdb_fd= open(pathbuf_sfx(&rw->pbsome,".cdb"), O_RDONLY);
  if (rw->cdb_fd >=0) {
    rc= cdbinit(ip, rw);  if (rc) goto x_rc;
  } else if (errno == ENOENT) {
    if (rw->mainsz > 1) {
      rc= cht_staticerr(ip, ".cdb does not exist but .main is >1byte -"
			" .cdb must have been accidentally deleted!",
			"CDB CDBMISSING");
      goto x_rc;
    }
    /* fine */
  } else {
    PE("open .cdb");
  }

  rw->logfile= fopen(pathbuf_sfx(&rw->pbsome,".jrn"), "r+");
  if (!rw->logfile) {
    if (errno != ENOENT) PE("failed to open .jrn during open");
    rw->logfile= fopen(rw->pbsome.buf, "w");
    if (!rw->logfile) PE("create .jrn during (clean) open");
  } else { /* rw->logfile */
    r= fstat(fileno(rw->logfile), &stab);
    if (r==-1) PE("fstat .jrn during open");
    rc= infocb(ip, rw, "open-dirty-start", "log=%luby",
	       (unsigned long)stab.st_size);
    if (rc) goto x_rc;

    for (;;) {
      logrecstart= ftello(rw->logfile);
      if (logrecstart < 0) PE("ftello .jrn during (dirty) open");
      r= readstorelogrecord(rw->logfile, &rw->logincore, 0,0, ht_update);
      if (ferror(rw->logfile)) {
	rc= cht_posixerr(ip, errno, "error reading .jrn during (dirty) open");
	goto x_rc;
      }
      if (r==-1) {
	break;
      } else if (r==-2 || r==-3) {
	char buf[100];
	logjunkpos= ftello(rw->logfile);
	if(logjunkpos<0) PE("ftello .jrn during report of junk in dirty open");

	snprintf(buf,sizeof(buf), "CDB SYNTAX LOG %lu %lu",
		 (unsigned long)logjunkpos, (unsigned long)logrecstart);

	if (!(subcmd->flags & RWSCF_OKJUNK)) {
	  Tcl_SetObjErrorCode(ip, Tcl_NewStringObj(buf,-1));
	  snprintf(buf,sizeof(buf),"%lu",(unsigned long)logjunkpos);
	  Tcl_ResetResult(ip);
	  Tcl_AppendResult(ip, "syntax error (junk) in .jrn during"
			   " (dirty) open, at file position ", buf, (char*)0);
	  rc= TCL_ERROR;
	  goto x_rc;
	}
	rc= infocb3(ip, rw, "open-dirty-junk", "errorfpos=%luby", buf,
		    (unsigned long)logjunkpos);
	if (rc) goto x_rc;

	r= fseeko(rw->logfile, logrecstart, SEEK_SET);
	if (r) PE("failed to fseeko .jrn before junk during dirty open");

	r= ftruncate(fileno(rw->logfile), logrecstart);
	if (r) PE("ftruncate .jrn to chop junk during dirty open");
      } else {
	assert(!r);
      }
    }
  }
  /* now log is positioned for appending and everything is read */

  *result= rw;
  maybe_close(mainfd);
  return TCL_OK;

 x_rc:
  rw_close(0,rw);
  TFREE(rw);
  maybe_close(mainfd);
  return rc;
}

int cht_do_cdbwr_open_okjunk(ClientData cd, Tcl_Interp *ip, const char *pathb,
		      Tcl_Obj *on_info, Tcl_Obj *on_lexminval,
		      void **result) {
  return cht_do_cdbwr_open(cd,ip,pathb,on_info,on_lexminval,result);
}

/*==================== COMPACTION ====================*/

struct ht_forall_ctx {
  struct cdb_make cdbm;
  FILE *mainfile;
  long *reccount;
  int lexminvall;
  const char *lexminval; /* may be invalid if lexminvall <= 0 */
};

/*---------- helper functions ----------*/

static int expiredp(const HashValue *val, struct ht_forall_ctx *a) {
  int r, l;
  if (!val->len || a->lexminvall<=0) return 0;
  l= val->len < a->lexminvall ? val->len : a->lexminvall;
  r= memcmp(val->data, a->lexminval, l);
  if (r>0) return 0;
  if (r<0) return 1;
  return val->len < a->lexminvall;
}

static int delete_ifexpired(const char *key, HashValue *val,
			    struct ht_forall_ctx *a) {
  if (!expiredp(val, a)) return 0;
  val->len= 0;
  /* we don't actually need to realloc it to free the memory because
   * this will shortly all be deleted as part of the compaction */
  return 0;
}

static int addto_cdb(const char *key, HashValue *val,
		     struct ht_forall_ctx *a) {
  return cdb_make_add(&a->cdbm, key, strlen(key), val->data, val->len);
}

static int addto_main(const char *key, HashValue *val,
		      struct ht_forall_ctx *a) {
  (*a->reccount)++;
  return writerecord(a->mainfile, key, val);
}

/*---------- compact main entrypoint ----------*/

static int compact_core(Tcl_Interp *ip, Rw *rw, unsigned long logsz,
			long *reccount_r) {
  /* creates new .cdb and .main
   * closes logfile
   * leaves .jrn with old data
   * leaves cdb fd open onto old db
   * leaves logincore full of crap
   */
  int r, rc;
  int cdbfd, cdbmaking;
  off_t errpos, newmainsz;
  char buf[100];
  Tcl_Obj *res;
  struct ht_forall_ctx a;

  a.mainfile= 0;
  cdbfd= -1;
  cdbmaking= 0;
  *reccount_r= 0;
  a.reccount= reccount_r;

  r= fclose(rw->logfile);
  rw->logfile= 0;
  if (r) { rc= cht_posixerr(ip, errno, "probable data loss!  failed to fclose"
			    " logfile during compact");  goto x_rc; }
  
  rc= infocb(ip, rw, "compact-start", "log=%luby main=%luby",
	     logsz, (unsigned long)rw->mainsz);
  if (rc) goto x_rc;

  if (cht_scriptinv_interp(&rw->on_lexminval)) {
    rc= cht_scriptinv_invoke_fg(&rw->on_lexminval, 0,0);
    if (rc) goto x_rc;

    res= Tcl_GetObjResult(ip);  assert(res);
    a.lexminval= Tcl_GetStringFromObj(res, &a.lexminvall);
    assert(a.lexminval);

    /* we rely not calling Tcl_Eval during the actual compaction;
     * if we did Tcl_Eval then the interp result would be trashed.
     */
    rc= ht_forall(&rw->logincore, delete_ifexpired, &a);

  } else {
    a.lexminvall= 0;
  }

  /* merge unsuperseded records from main into hash table */

  a.mainfile= fopen(pathbuf_sfx(&rw->pbsome,".main"), "r");
  if (!a.mainfile) PE("failed to open .main for reading during compact");

  for (;;) {
    r= readstorelogrecord(a.mainfile, &rw->logincore,
			  expiredp, &a,
			  ht_maybeupdate);
    if (ferror(a.mainfile)) { rc= cht_posixerr(ip, errno, "error reading"
                         " .main during compact"); goto x_rc; }
    if (r==-3) {
      break;
    } else if (r==-1 || r==-2) {
      errpos= ftello(a.mainfile);
      if (errpos<0) PE("ftello .main during report of syntax error");
      snprintf(buf,sizeof(buf), "CDB %s MAIN %lu",
	       r==-1 ? "TRUNCATED" : "SYNTAX", (unsigned long)errpos);
      Tcl_SetObjErrorCode(ip, Tcl_NewStringObj(buf,-1));
      snprintf(buf,sizeof(buf), "%lu", (unsigned long)errpos);
      Tcl_ResetResult(ip);
      Tcl_AppendResult(ip,
		       r==-1 ? "unexpected eof (truncated file)"
		       " in .main during compact, at file position "
		       : "syntax error"
		       " in .main during compact, at file position ",
		       buf, (char*)0);
      rc= TCL_ERROR;
      goto x_rc;
    } else {
      assert(!rc);
    }
  }
  fclose(a.mainfile);
  a.mainfile= 0;

  /* create new cdb */

  cdbfd= open(pathbuf_sfx(&rw->pbsome,".tmp"), O_WRONLY|O_CREAT|O_TRUNC, 0666);
  if (cdbfd<0) PE("create .tmp for new cdb during compact");

  r= cdb_make_start(&a.cdbm, cdbfd);
  if (r) PE("cdb_make_start during compact");
  cdbmaking= 1;

  r= ht_forall(&rw->logincore, addto_cdb, &a);
  if (r) PE("cdb_make_add during compact");

  r= cdb_make_finish(&a.cdbm);
  if(r) PE("cdb_make_finish during compact");
  cdbmaking= 0;

  r= fdatasync(cdbfd);  if (r) PE("fdatasync new cdb during compact");
  r= close(cdbfd);  if (r) PE("close new cdb during compact");
  cdbfd= -1;

  r= rename(rw->pbsome.buf, pathbuf_sfx(&rw->pbother,".cdb"));
  if (r) PE("install new .cdb during compact");

  /* create new main */

  a.mainfile= fopen(pathbuf_sfx(&rw->pbsome,".tmp"), "w");
  if (!a.mainfile) PE("create .tmp for new main during compact");

  r= ht_forall(&rw->logincore, addto_main, &a);
  if (r) { rc= cht_posixerr(ip, errno, "error writing to new .main"
			    " during compact");  goto x_rc; }

  r= putc('\n', a.mainfile);
  if (r==EOF) PE("write trailing \n to main during compact");
  
  r= fflush(a.mainfile);  if (r) PE("fflush new main during compact");
  r= fdatasync(fileno(a.mainfile));
  if (r) PE("fdatasync new main during compact");

  newmainsz= ftello(a.mainfile);
  if (newmainsz<0) PE("ftello new main during compact");
  
  r= fclose(a.mainfile);  if (r) PE("fclose new main during compact");
  a.mainfile= 0;

  r= rename(rw->pbsome.buf, pathbuf_sfx(&rw->pbother,".main"));
  if (r) PE("install new .main during compact");

  rw->mainsz= newmainsz;

  /* done! */
  
  rc= infocb(ip, rw, "compact-end", "main=%luby nrecs=%ld",
	     (unsigned long)rw->mainsz, *a.reccount);
  if (rc) goto x_rc;

  return rc;

x_rc:
  if (a.mainfile) fclose(a.mainfile);
  if (cdbmaking) cdb_make_finish(&a.cdbm);
  maybe_close(cdbfd);
  remove(pathbuf_sfx(&rw->pbsome,".tmp")); /* for tidyness */
  return rc;
}

/*---------- Closing ----------*/

static int compact_forclose(Tcl_Interp *ip, Rw *rw, long *reccount_r) {
  off_t logsz;
  int r, rc;

  logsz= ftello(rw->logfile);
  if (logsz < 0) PE("ftello logfile (during tidy close)");

  rc= compact_core(ip, rw, logsz, reccount_r);  if (rc) goto x_rc;

  r= remove(pathbuf_sfx(&rw->pbsome,".jrn"));
  if (r) PE("remove .jrn (during tidy close)");

  return TCL_OK;

x_rc: return rc;
}
  
int cht_do_cdbwr_close(ClientData cd, Tcl_Interp *ip, void *rw_v) {
  Rw *rw= rw_v;
  int rc, rc_close;
  long reccount= -1;
  off_t logsz;

  if (rw->autocompact) rc= compact_forclose(ip, rw, &reccount);
  else rc= TCL_OK;

  if (!rc) {
    if (rw->logfile) {
      logsz= ftello(rw->logfile);
      if (logsz < 0)
	rc= cht_posixerr(ip, errno, "ftell logfile during close info");
      else
	rc= infocb(ip, rw, "close", "main=%luby log=%luby",
		   rw->mainsz, logsz);
    } else if (reccount>=0) {
      rc= infocb(ip, rw, "close", "main=%luby nrecs=%ld",
		 rw->mainsz, reccount);
    } else {
      rc= infocb(ip, rw, "close", "main=%luby", rw->mainsz);
    }
  }
  rc_close= rw_close(ip,rw);
  if (rc_close) rc= rc_close;
  
  cht_tabledataid_disposing(ip, rw_v, &cdbtcl_rwdatabases);
  TFREE(rw);
  return rc;
}

/*---------- Other compaction-related entrypoints ----------*/

static int compact_keepopen(Tcl_Interp *ip, Rw *rw, int force) {
  off_t logsz;
  long reccount;
  int rc, r;

  logsz= ftello(rw->logfile);
  if (logsz < 0) return cht_posixerr(ip, errno, "ftell .jrn"
				       " during compact check or force");

  if (!force && logsz < rw->mainsz / 3 + 1000) return TCL_OK;
  /* Test case:                    ^^^ testing best value for this
   *   main=9690434by nrecs=122803  read all in one go
   *  no autocompact, :    6.96user 0.68system 0:08.93elapsed
   *  auto, mulitplier 2:  7.10user 0.79system 0:09.54elapsed
   *  auto, unity:         7.80user 0.98system 0:11.84elapsed
   *  auto, divisor  2:    8.23user 1.05system 0:13.30elapsed
   *  auto, divisor  3:    8.55user 1.12system 0:12.88elapsed
   *  auto, divisor  5:    9.95user 1.43system 0:15.72elapsed
   */

  rc= compact_core(ip, rw, logsz, &reccount);  if (rc) goto x_rc;

  rw_cdb_close(ip,rw);
  ht_destroy(&rw->logincore);
  ht_setup(&rw->logincore);

  rw->cdb_fd= open(pathbuf_sfx(&rw->pbsome,".cdb"), O_RDONLY);
  if (rw->cdb_fd < 0) PE("reopen .cdb after compact");

  rc= cdbinit(ip, rw);  if (rc) goto x_rc;

  rw->logfile= fopen(pathbuf_sfx(&rw->pbsome,".jrn"), "w");
  if (!rw->logfile) PE("reopen .jrn after compact");

  r= fsync(fileno(rw->logfile));  if (r) PE("fsync .jrn after compact reopen");

  return TCL_OK;

x_rc:
  /* doom! all updates fail after this (because rw->logfile is 0), and
   * we may be using a lot more RAM than would be ideal.  Program will
   * have to reopen if it really wants sanity. */
  return rc;
}

int cht_do_cdbwr_compact_force(ClientData cd, Tcl_Interp *ip, void *rw_v) {
  return compact_keepopen(ip, rw_v, 1);
}
int cht_do_cdbwr_compact_check(ClientData cd, Tcl_Interp *ip, void *rw_v) {
  return compact_keepopen(ip, rw_v, 0);
}

int cht_do_cdbwr_compact_explicit(ClientData cd, Tcl_Interp *ip, void *rw_v) {
  Rw *rw= rw_v;
  rw->autocompact= 0;
  return TCL_OK;
}
int cht_do_cdbwr_compact_auto(ClientData cd, Tcl_Interp *ip, void *rw_v) {
  Rw *rw= rw_v;
  rw->autocompact= 1;
  return TCL_OK;
}

/*---------- Updateing ----------*/

static int update(Tcl_Interp *ip, Rw *rw, const char *key,
		  const Byte *data, int dlen) {
  HashValue *val;
  const char *failed;
  int rc, r;
  off_t recstart;

  if (strlen(key) >= KEYLEN_MAX)
    return cht_staticerr(ip, "key too long", "CDB KEYOVERFLOW");

  if (!rw->logfile) return cht_staticerr
    (ip, "failure during previous compact or error recovery;"
     " cdbwr must be closed and reopened before any further updates",
     "CDB BROKEN");
  
  recstart= ftello(rw->logfile);
  if (recstart < 0)
    return cht_posixerr(ip, errno, "failed to ftello .jrn during update");

  val= htv_prep(dlen);  assert(val);
  memcpy(htv_fillptr(val), data, dlen);

  r= writerecord(rw->logfile, key, val);
  if (!r) r= fflush(rw->logfile);
  if (r) PE("write update to logfile");

  ht_update(&rw->logincore, key, val);

  if (!rw->autocompact) return TCL_OK;
  return compact_keepopen(ip, rw, 0);

 x_rc:
  TFREE(val);
  assert(rc);

  /* Now, we have to try to sort out the journal so that it's
   * truncated and positioned to where this abortively-written record
   * started, with no buffered output and the error indicator clear.
   *
   * There seems to be no portable way to ensure the buffered unwritten
   * output is discarded, so we close and reopen the stream.
   */
  fclose(rw->logfile);

  rw->logfile= fopen(pathbuf_sfx(&rw->pbsome,".jrn"), "r+");
  if (!rw->logfile) { failed= "fopen"; goto reset_fail; }

  r= ftruncate(fileno(rw->logfile), recstart);
  if (r) { failed= "ftruncate"; goto reset_fail; }

  r= fseeko(rw->logfile, recstart, SEEK_SET);
  if (r) { failed= "fseeko"; goto reset_fail; }

  return rc;

 reset_fail:
  Tcl_AppendResult(ip, " (additionally, ", failed, " failed"
		   " in error recovery: ", strerror(errno), ")", (char*)0);
  if (rw->logfile) { fclose(rw->logfile); rw->logfile= 0; }

  return rc;
}  

int cht_do_cdbwr_update(ClientData cd, Tcl_Interp *ip,
			void *rw_v, const char *key, Tcl_Obj *value) {
  int dlen;
  const char *data;
  data= Tcl_GetStringFromObj(value, &dlen);  assert(data);
  return update(ip, rw_v, key, data, dlen);
}

int cht_do_cdbwr_update_hb(ClientData cd, Tcl_Interp *ip,
			   void *rw_v, const char *key, HBytes_Value value) {
  return update(ip, rw_v, key, cht_hb_data(&value), cht_hb_len(&value));
}

int cht_do_cdbwr_delete(ClientData cd, Tcl_Interp *ip, void *rw_v,
			const char *key) {
  return update(ip, rw_v, key, 0, 0);
}

/*---------- Lookups ----------*/

static int lookup_rw(Tcl_Interp *ip, void *rw_v, const char *key,
		    const Byte **data_r, int *len_r /* -1 => notfound */) {
  Rw *rw= rw_v;
  const HashValue *val;

  val= ht_lookup(&rw->logincore, key);
  if (val) {
    if (val->len) { *data_r= val->data; *len_r= val->len; return TCL_OK; }
    else goto not_found;
  }

  if (rw->cdb_fd<0) goto not_found;

  return cht_cdb_lookup_cdb(ip, &rw->cdb, key, strlen(key), data_r, len_r);

 not_found:
  *data_r= 0;
  *len_r= -1;
  return TCL_OK;
}

int cht_do_cdbwr_lookup(ClientData cd, Tcl_Interp *ip, void *rw_v,
			const char *key, Tcl_Obj *def,
			Tcl_Obj **result) {
  const Byte *data;
  int dlen, r;
  
  r= lookup_rw(ip, rw_v, key, &data, &dlen);  if (r) return r;
  return cht_cdb_donesomelookup(ip, rw_v, def, result, data, dlen,
				cht_cdb_storeanswer_string);
}
  
int cht_do_cdbwr_lookup_hb(ClientData cd, Tcl_Interp *ip, void *rw_v,
			   const char *key, Tcl_Obj *def,
			   Tcl_Obj **result) {
  const Byte *data;
  int dlen, r;
  
  r= lookup_rw(ip, rw_v, key, &data, &dlen);  if (r) return r;
  return cht_cdb_donesomelookup(ip, rw_v, def, result, data, dlen,
				cht_cdb_storeanswer_hb);
}
