chiark / gitweb /
02c98cb8ad773230984f454f02f8b3205d826213
[chiark-tcl.git] / cdb / writeable.c
1 /*
2  * cdb, cdb-wr - Tcl bindings for tinycdb and a journalling write extension
3  * Copyright 2006 Ian Jackson
4  *
5  * This program is free software; you can redistribute it and/or
6  * modify it under the terms of the GNU General Public License as
7  * published by the Free Software Foundation; either version 2 of the
8  * License, or (at your option) any later version.
9  *
10  * This program is distributed in the hope that it will be useful, but
11  * WITHOUT ANY WARRANTY; without even the implied warranty of
12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
13  * General Public License for more details.
14  *
15  * You should have received a copy of the GNU General Public License
16  * along with this library; if not, write to the Free Software
17  * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
18  * 02110-1301, USA.
19  */
20
21 #include "chiark_tcl_cdb.h"
22
23 #define KEYLEN_MAX (INT_MAX/2)
24
25 #define ftello ftell
26 #define fseeko fseek
27
28 /*---------- Forward declarations ----------*/
29
30 struct ht_forall_ctx;
31
32 /*---------- Useful routines ----------*/
33
34 static void maybe_close(int fd) {
35   if (fd>=0) close(fd);
36 }
37
38 /*==================== Subsystems and subtypes ====================*/
39
40 /*---------- Pathbuf ----------*/
41
42 typedef struct Pathbuf {
43   char *buf, *sfx;
44 } Pathbuf;
45
46 #define MAX_SUFFIX 5
47
48 static void pathbuf_init(Pathbuf *pb, const char *pathb) {
49   size_t l= strlen(pathb);
50   assert(l < INT_MAX);
51   pb->buf= TALLOC(l + MAX_SUFFIX + 1);
52   memcpy(pb->buf, pathb, l);
53   pb->sfx= pb->buf + l;
54 }
55 static const char *pathbuf_sfx(Pathbuf *pb, const char *suffix) {
56   assert(strlen(suffix) <= MAX_SUFFIX);
57   strcpy(pb->sfx, suffix);
58   return pb->buf;
59 }
60 static void pathbuf_free(Pathbuf *pb) {
61   TFREE(pb->buf);
62   pb->buf= 0;
63 }
64
65 /*---------- Our hash table ----------*/
66
67 typedef struct HashTable {
68   Tcl_HashTable t;
69   Byte padding[128]; /* allow for expansion by Tcl, urgh */
70   Byte confound[16];
71 } HashTable;
72
73 typedef struct HashValue {
74   int len;
75   Byte data[1];
76 } HashValue;
77
78 static HashValue *htv_prep(int len) {
79   HashValue *hd;
80   hd= TALLOC((hd->data - (Byte*)hd) + len);
81   hd->len= len;
82   return hd;
83 }  
84 static Byte *htv_fillptr(HashValue *hd) {
85   return hd->data;
86 }
87
88 static void ht_setup(HashTable *ht) {
89   Tcl_InitHashTable(&ht->t, TCL_STRING_KEYS);
90 }
91 static void ht_update(HashTable *ht, const char *key, HashValue *val_eat) {
92   Tcl_HashEntry *he;
93   int new;
94
95   he= Tcl_CreateHashEntry(&ht->t, (char*)key, &new);
96   if (!new) TFREE(Tcl_GetHashValue(he));
97   Tcl_SetHashValue(he, val_eat);
98     /* eats the value since the data structure owns the memory */
99 }
100 static void ht_maybeupdate(HashTable *ht, const char *key,
101                            HashValue *val_eat) {
102   /* like ht_update except does not overwrite existing values */
103   Tcl_HashEntry *he;
104   int new;
105
106   he= Tcl_CreateHashEntry(&ht->t, (char*)key, &new);
107   if (!new) { TFREE(val_eat); return; }
108   Tcl_SetHashValue(he, val_eat);
109 }
110
111 static const HashValue *ht_lookup(HashTable *ht, const char *key) {
112   Tcl_HashEntry *he;
113   
114   he= Tcl_FindHashEntry(&ht->t, key);
115   if (!he) return 0;
116   
117   return Tcl_GetHashValue(he);
118 }
119
120 static int ht_forall(HashTable *ht,
121                      int (*fn)(const char *key, HashValue *val,
122                                struct ht_forall_ctx *ctx),
123                      struct ht_forall_ctx *ctx) {
124   /* Returns first positive value returned by any call to fn, or 0. */
125   Tcl_HashSearch sp;
126   Tcl_HashEntry *he;
127   const char *key;
128   HashValue *val;
129   int r;
130   
131   for (he= Tcl_FirstHashEntry(&ht->t, &sp);
132        he;
133        he= Tcl_NextHashEntry(&sp)) {
134     val= Tcl_GetHashValue(he);
135     if (!val->len) continue;
136
137     key= Tcl_GetHashKey(&ht->t, he);
138     
139     r= fn(key, val, ctx);
140     if (r) return r;
141   }
142   return 0;
143 }
144
145 static void ht_destroy(HashTable *ht) {
146   Tcl_HashSearch sp;
147   Tcl_HashEntry *he;
148   
149   for (he= Tcl_FirstHashEntry(&ht->t, &sp);
150        he;
151        he= Tcl_NextHashEntry(&sp)) {
152     /* ht_forall skips empty (deleted) entries so is no good for this */
153     TFREE(Tcl_GetHashValue(he));
154   }
155   Tcl_DeleteHashTable(&ht->t);
156 }
157
158 /*==================== Existential ====================*/
159
160 /*---------- Rw data structure ----------*/
161
162 typedef struct Rw {
163   int ix, autocompact;
164   int cdb_fd, lock_fd;
165   struct cdb cdb; /* valid iff cdb_fd >= 0 */
166   FILE *logfile; /* may be 0; if so, is broken */
167   HashTable logincore;
168   Pathbuf pbsome, pbother;
169   off_t mainsz;
170   ScriptToInvoke on_info, on_lexminval;
171 } Rw;
172
173 static int rw_close(Tcl_Interp *ip, Rw *rw) {
174   int rc, r;
175
176   rc= TCL_OK;
177   ht_destroy(&rw->logincore);
178   if (rw->cdb_fd >= 0) cdb_free(&rw->cdb);
179   maybe_close(rw->cdb_fd);
180   maybe_close(rw->lock_fd);
181
182   if (rw->logfile) {
183     r= fclose(rw->logfile);
184     if (r && ip) { rc= cht_posixerr(ip, errno, "probable data loss! failed to"
185                                     " fclose logfile during untidy close"); }
186   }
187
188   pathbuf_free(&rw->pbsome); pathbuf_free(&rw->pbother);
189   return rc;
190 }
191
192 static void destroy_cdbrw_idtabcb(Tcl_Interp *ip, void *rw_v) {
193   rw_close(0,rw_v);
194   TFREE(rw_v);
195 }
196 const IdDataSpec cdbtcl_rwdatabases= {
197   "cdb-rwdb", "cdb-openrwdatabases-table", destroy_cdbrw_idtabcb
198 };
199
200 /*---------- File handling ----------*/
201
202 static int acquire_lock(Tcl_Interp *ip, Pathbuf *pb, int *lockfd_r) {
203   /* *lockfd_r must be -1 on entry.  If may be set to >=0 even
204    * on error, and must be closed by the caller. */
205   mode_t um, lockmode;
206   struct flock fl;
207   int r;
208
209   um= umask(~(mode_t)0);
210   umask(um);
211
212   lockmode= 0666 & ~((um & 0444)>>1);
213   /* Remove r where umask would remove w;
214    * eg umask intending 0664 here gives 0660 */
215   
216   *lockfd_r= open(pathbuf_sfx(pb,".lock"), O_RDWR|O_CREAT, lockmode);
217   if (*lockfd_r < 0)
218     return cht_posixerr(ip, errno, "could not open/create lockfile");
219
220   fl.l_type= F_WRLCK;
221   fl.l_whence= SEEK_SET;
222   fl.l_start= 0;
223   fl.l_len= 0;
224   fl.l_pid= getpid();
225
226   r= fcntl(*lockfd_r, F_SETLK, &fl);
227   if (r == -1) {
228     if (errno == EACCES || errno == EAGAIN)
229       return cht_staticerr(ip, "lock held by another process", "CDB LOCKED");
230     else return cht_posixerr(ip, errno, "unexpected error from fcntl while"
231                              " acquiring lock");
232   }
233
234   return TCL_OK;
235 }
236
237 /*---------- Log reading and writing ----------*/
238
239 static int readlognum(FILE *f, int delim, int *num_r) {
240   int c;
241   char numbuf[20], *p, *ep;
242   unsigned long ul;
243
244   p= numbuf;
245   for (;;) {
246     c= getc(f);  if (c==EOF) return -2;
247     if (c == delim) break;
248     if (!isdigit((unsigned char)c)) return -2;
249     *p++= c;
250     if (p == numbuf+sizeof(numbuf)) return -2;
251   }
252   if (p == numbuf) return -2;
253   *p= 0;
254
255   errno=0; ul= strtoul(numbuf, &ep, 10);
256   if (*ep || errno || ul >= KEYLEN_MAX) return -2;
257   *num_r= ul;
258   return 0;
259 }
260
261 static int readstorelogrecord(FILE *f, HashTable *ht,
262                               int (*omitfn)(const HashValue*,
263                                             struct ht_forall_ctx *ctx),
264                               struct ht_forall_ctx *ctx,
265                               void (*updatefn)(HashTable*, const char*,
266                                                HashValue*)) {
267   /* returns:
268    *      0     for OK
269    *     -1     eof
270    *     -2     corrupt or error
271    *     -3     got newline indicating end
272    *     >0     value from omitfn
273    */
274   int keylen, vallen;
275   char *key;
276   HashValue *val;
277   int c, rc, r;
278
279   c= getc(f);
280   if (c==EOF) { return feof(f) ? -1 : -2; }
281   if (c=='\n') return -3;
282   if (c!='+') return -2;
283
284   rc= readlognum(f, ',', &keylen);  if (rc) return rc;
285   rc= readlognum(f, ':', &vallen);  if (rc) return rc;
286
287   key= TALLOC(keylen+1);
288   val= htv_prep(vallen);
289
290   r= fread(key, 1,keylen, f);
291   if (r!=keylen) goto x2_free_keyval;
292   if (memchr(key,0,keylen)) goto x2_free_keyval;
293   key[keylen]= 0;
294
295   c= getc(f);  if (c!='-') goto x2_free_keyval;
296   c= getc(f);  if (c!='>') goto x2_free_keyval;
297   
298   r= fread(htv_fillptr(val), 1,vallen, f);
299   if (r!=vallen) goto x2_free_keyval;
300
301   c= getc(f);  if (c!='\n') goto x2_free_keyval;
302
303   rc= omitfn ? omitfn(val, ctx) : TCL_OK;
304   if (rc) { assert(rc>0); TFREE(val); }
305   else updatefn(ht, key, val);
306   
307   TFREE(key);
308   return rc;
309
310  x2_free_keyval:
311   TFREE(val);
312   TFREE(key);
313   return -2;
314 }
315
316 static int writerecord(FILE *f, const char *key, const HashValue *val) {
317   int r;
318
319   r= fprintf(f, "+%d,%d:%s->", (int)strlen(key), val->len, key);
320   if (r<0) return -1;
321   
322   r= fwrite(val->data, 1, val->len, f);
323   if (r != val->len) return -1;
324
325   r= putc('\n', f);
326   if (r==EOF) return -1;
327
328   return 0;
329 }
330
331 /*---------- Creating ----------*/
332
333 int cht_do_cdbwr_create_empty(ClientData cd, Tcl_Interp *ip,
334                               const char *pathb) {
335   static const char *const toremoves[]= { ".cdb", ".jrn", ".tmp", 0 };
336
337   Pathbuf pb, pbmain;
338   int lock_fd=-1, rc, r;
339   FILE *f= 0;
340   const char *const *toremove;
341   struct stat stab;
342
343   pathbuf_init(&pb, pathb);
344   pathbuf_init(&pbmain, pathb);
345
346   rc= acquire_lock(ip, &pb, &lock_fd);  if (rc) goto x_rc;
347
348   r= lstat(pathbuf_sfx(&pbmain, ".main"), &stab);
349   if (!r) { rc= cht_staticerr(ip, "database already exists during creation",
350                               "CDB ALREADY-EXISTS");  goto x_rc; }
351   if (errno != ENOENT) PE("check for existing database .main during creation");
352
353   for (toremove=toremoves; *toremove; toremove++) {
354     r= remove(pathbuf_sfx(&pb, *toremove));
355     if (r && errno != ENOENT)
356       PE("delete possible spurious file during creation");
357   }
358   
359   f= fopen(pathbuf_sfx(&pb, ".tmp"), "w");
360   if (!f) PE("create new database .tmp");  
361   r= putc('\n', f);  if (r==EOF) PE("write sentinel to new database .tmp");
362   r= fclose(f);  f=0;  if (r) PE("close new database .tmp during creation");
363
364   r= rename(pb.buf, pbmain.buf);
365   if (r) PE("install new database .tmp as .main (finalising creation)");
366   
367   rc= TCL_OK;
368
369  x_rc:
370   if (f) fclose(f);
371   maybe_close(lock_fd);
372   pathbuf_free(&pb);
373   pathbuf_free(&pbmain);
374   return rc;
375 }
376
377 /*---------- Info callbacks ----------*/
378
379 static int infocbv3(Tcl_Interp *ip, Rw *rw, const char *arg1,
380                     const char *arg2fmt, const char *arg3, va_list al) {
381   Tcl_Obj *aa[3];
382   int na;
383   char buf[200];
384   vsnprintf(buf, sizeof(buf), arg2fmt, al);
385
386   na= 0;
387   aa[na++]= cht_ret_string(ip, arg1);
388   aa[na++]= cht_ret_string(ip, buf);
389   if (arg3) aa[na++]= cht_ret_string(ip, arg3);
390   
391   return cht_scriptinv_invoke_fg(&rw->on_info, na, aa);
392 }
393   
394 static int infocb3(Tcl_Interp *ip, Rw *rw, const char *arg1,
395                    const char *arg2fmt, const char *arg3, ...) {
396   int rc;
397   va_list al;
398   va_start(al, arg3);
399   rc= infocbv3(ip,rw,arg1,arg2fmt,arg3,al);
400   va_end(al);
401   return rc;
402 }
403   
404 static int infocb(Tcl_Interp *ip, Rw *rw, const char *arg1,
405                   const char *arg2fmt, ...) {
406   int rc;
407   va_list al;
408   va_start(al, arg2fmt);
409   rc= infocbv3(ip,rw,arg1,arg2fmt,0,al);
410   va_end(al);
411   return rc;
412 }
413   
414 /*---------- Opening ----------*/
415
416 static int cdbinit(Tcl_Interp *ip, Rw *rw) {
417   /* On entry, cdb_fd >=0 but cdb is _undefined_/
418    * On exit, either cdb_fd<0 or cdb is initialised */
419   int r, rc;
420   
421   r= cdb_init(&rw->cdb, rw->cdb_fd);
422   if (r) {
423     rc= cht_posixerr(ip, errno, "failed to initialise cdb reader");
424     close(rw->cdb_fd);  rw->cdb_fd= -1;  return rc;
425   }
426   return TCL_OK;
427 }
428
429 int cht_do_cdbwr_open(ClientData cd, Tcl_Interp *ip, const char *pathb,
430                       Tcl_Obj *on_info, Tcl_Obj *on_lexminval,
431                       void **result) {
432   const Cdbwr_SubCommand *subcmd= cd;
433   int r, rc, mainfd=-1;
434   Rw *rw;
435   struct stat stab;
436   off_t logrecstart, logjunkpos;
437
438   rw= TALLOC(sizeof(*rw));
439   rw->ix= -1;
440   ht_setup(&rw->logincore);
441   cht_scriptinv_init(&rw->on_info);
442   cht_scriptinv_init(&rw->on_lexminval);
443   rw->cdb_fd= rw->lock_fd= -1;  rw->logfile= 0;
444   pathbuf_init(&rw->pbsome, pathb);
445   pathbuf_init(&rw->pbother, pathb);
446   rw->autocompact= 1;
447
448   rc= cht_scriptinv_set(&rw->on_info, ip, on_info, 0);
449   if (rc) goto x_rc;
450
451   rc= cht_scriptinv_set(&rw->on_lexminval, ip, on_lexminval, 0);
452   if (rc) goto x_rc;
453
454   mainfd= open(pathbuf_sfx(&rw->pbsome,".main"), O_RDONLY);
455   if (mainfd<0) PE("open existing database file .main");
456   rc= acquire_lock(ip, &rw->pbsome, &rw->lock_fd);  if (rc) goto x_rc;
457
458   r= fstat(mainfd, &stab);  if (r) PE("fstat .main");
459   rw->mainsz= stab.st_size;
460
461   rw->cdb_fd= open(pathbuf_sfx(&rw->pbsome,".cdb"), O_RDONLY);
462   if (rw->cdb_fd >=0) {
463     rc= cdbinit(ip, rw);  if (rc) goto x_rc;
464   } else if (errno == ENOENT) {
465     if (rw->mainsz > 1) {
466       rc= cht_staticerr(ip, ".cdb does not exist but .main is >1byte -"
467                         " .cdb must have been accidentally deleted!",
468                         "CDB CDBMISSING");
469       goto x_rc;
470     }
471     /* fine */
472   } else {
473     PE("open .cdb");
474   }
475
476   rw->logfile= fopen(pathbuf_sfx(&rw->pbsome,".jrn"), "r+");
477   if (!rw->logfile) {
478     if (errno != ENOENT) PE("failed to open .jrn during open");
479     rw->logfile= fopen(rw->pbsome.buf, "w");
480     if (!rw->logfile) PE("create .jrn during (clean) open");
481   } else { /* rw->logfile */
482     r= fstat(fileno(rw->logfile), &stab);
483     if (r==-1) PE("fstat .jrn during open");
484     rc= infocb(ip, rw, "open-dirty-start", "log=%luby",
485                (unsigned long)stab.st_size);
486     if (rc) goto x_rc;
487
488     for (;;) {
489       logrecstart= ftello(rw->logfile);
490       if (logrecstart < 0) PE("ftello .jrn during (dirty) open");
491       r= readstorelogrecord(rw->logfile, &rw->logincore, 0,0, ht_update);
492       if (ferror(rw->logfile)) {
493         rc= cht_posixerr(ip, errno, "error reading .jrn during (dirty) open");
494         goto x_rc;
495       }
496       if (r==-1) {
497         break;
498       } else if (r==-2 || r==-3) {
499         char buf[100];
500         logjunkpos= ftello(rw->logfile);
501         if(logjunkpos<0) PE("ftello .jrn during report of junk in dirty open");
502
503         snprintf(buf,sizeof(buf), "CDB SYNTAX LOG %lu %lu",
504                  (unsigned long)logjunkpos, (unsigned long)logrecstart);
505
506         if (!(subcmd->flags & RWSCF_OKJUNK)) {
507           Tcl_SetObjErrorCode(ip, Tcl_NewStringObj(buf,-1));
508           snprintf(buf,sizeof(buf),"%lu",(unsigned long)logjunkpos);
509           Tcl_ResetResult(ip);
510           Tcl_AppendResult(ip, "syntax error (junk) in .jrn during"
511                            " (dirty) open, at file position ", buf, (char*)0);
512           rc= TCL_ERROR;
513           goto x_rc;
514         }
515         rc= infocb3(ip, rw, "open-dirty-junk", "errorfpos=%luby", buf,
516                     (unsigned long)logjunkpos);
517         if (rc) goto x_rc;
518
519         r= fseeko(rw->logfile, logrecstart, SEEK_SET);
520         if (r) PE("failed to fseeko .jrn before junk during dirty open");
521
522         r= ftruncate(fileno(rw->logfile), logrecstart);
523         if (r) PE("ftruncate .jrn to chop junk during dirty open");
524       } else {
525         assert(!r);
526       }
527     }
528   }
529   /* now log is positioned for appending and everything is read */
530
531   *result= rw;
532   maybe_close(mainfd);
533   return TCL_OK;
534
535  x_rc:
536   rw_close(0,rw);
537   TFREE(rw);
538   maybe_close(mainfd);
539   return rc;
540 }
541
542 int cht_do_cdbwr_open_okjunk(ClientData cd, Tcl_Interp *ip, const char *pathb,
543                       Tcl_Obj *on_info, Tcl_Obj *on_lexminval,
544                       void **result) {
545   return cht_do_cdbwr_open(cd,ip,pathb,on_info,on_lexminval,result);
546 }
547
548 /*==================== COMPACTION ====================*/
549
550 struct ht_forall_ctx {
551   struct cdb_make cdbm;
552   FILE *mainfile;
553   long *reccount;
554   int lexminvall;
555   const char *lexminval; /* may be invalid if lexminvall <= 0 */
556 };
557
558 /*---------- helper functions ----------*/
559
560 static int expiredp(const HashValue *val, struct ht_forall_ctx *a) {
561   int r, l;
562   if (!val->len || a->lexminvall<=0) return 0;
563   l= val->len < a->lexminvall ? val->len : a->lexminvall;
564   r= memcmp(val->data, a->lexminval, l);
565   if (r>0) return 0;
566   if (r<0) return 1;
567   return val->len < a->lexminvall;
568 }
569
570 static int delete_ifexpired(const char *key, HashValue *val,
571                             struct ht_forall_ctx *a) {
572   if (!expiredp(val, a)) return 0;
573   val->len= 0;
574   /* we don't actually need to realloc it to free the memory because
575    * this will shortly all be deleted as part of the compaction */
576   return 0;
577 }
578
579 static int addto_cdb(const char *key, HashValue *val,
580                      struct ht_forall_ctx *a) {
581   return cdb_make_add(&a->cdbm, key, strlen(key), val->data, val->len);
582 }
583
584 static int addto_main(const char *key, HashValue *val,
585                       struct ht_forall_ctx *a) {
586   (*a->reccount)++;
587   return writerecord(a->mainfile, key, val);
588 }
589
590 /*---------- compact main entrypoint ----------*/
591
592 static int compact_core(Tcl_Interp *ip, Rw *rw, unsigned long logsz,
593                         long *reccount_r) {
594   /* creates new .cdb and .main
595    * closes logfile
596    * leaves .jrn with old data
597    * leaves cdb fd open onto old db
598    * leaves logincore full of crap
599    */
600   int r, rc;
601   int cdbfd, cdbmaking;
602   off_t errpos, newmainsz;
603   char buf[100];
604   Tcl_Obj *res;
605   struct ht_forall_ctx a;
606
607   a.mainfile= 0;
608   cdbfd= -1;
609   cdbmaking= 0;
610   *reccount_r= 0;
611   a.reccount= reccount_r;
612
613   r= fclose(rw->logfile);
614   rw->logfile= 0;
615   if (r) { rc= cht_posixerr(ip, errno, "probable data loss!  failed to fclose"
616                             " logfile during compact");  goto x_rc; }
617   
618   rc= infocb(ip, rw, "compact-start", "log=%luby main=%luby",
619              logsz, (unsigned long)rw->mainsz);
620   if (rc) goto x_rc;
621
622   if (cht_scriptinv_interp(&rw->on_lexminval)) {
623     rc= cht_scriptinv_invoke_fg(&rw->on_lexminval, 0,0);
624     if (rc) goto x_rc;
625
626     res= Tcl_GetObjResult(ip);  assert(res);
627     a.lexminval= Tcl_GetStringFromObj(res, &a.lexminvall);
628     assert(a.lexminval);
629
630     /* we rely not calling Tcl_Eval during the actual compaction;
631      * if we did Tcl_Eval then the interp result would be trashed.
632      */
633     rc= ht_forall(&rw->logincore, delete_ifexpired, &a);
634
635   } else {
636     a.lexminvall= 0;
637   }
638
639   /* merge unsuperseded records from main into hash table */
640
641   a.mainfile= fopen(pathbuf_sfx(&rw->pbsome,".main"), "r");
642   if (!a.mainfile) PE("failed to open .main for reading during compact");
643
644   for (;;) {
645     r= readstorelogrecord(a.mainfile, &rw->logincore,
646                           expiredp, &a,
647                           ht_maybeupdate);
648     if (ferror(a.mainfile)) { rc= cht_posixerr(ip, errno, "error reading"
649                          " .main during compact"); goto x_rc; }
650     if (r==-3) {
651       break;
652     } else if (r==-1 || r==-2) {
653       errpos= ftello(a.mainfile);
654       if (errpos<0) PE("ftello .main during report of syntax error");
655       snprintf(buf,sizeof(buf), "CDB %s MAIN %lu",
656                r==-1 ? "TRUNCATED" : "SYNTAX", (unsigned long)errpos);
657       Tcl_SetObjErrorCode(ip, Tcl_NewStringObj(buf,-1));
658       snprintf(buf,sizeof(buf), "%lu", (unsigned long)errpos);
659       Tcl_ResetResult(ip);
660       Tcl_AppendResult(ip,
661                        r==-1 ? "unexpected eof (truncated file)"
662                        " in .main during compact, at file position "
663                        : "syntax error"
664                        " in .main during compact, at file position ",
665                        buf, (char*)0);
666       rc= TCL_ERROR;
667       goto x_rc;
668     } else {
669       assert(!rc);
670     }
671   }
672   fclose(a.mainfile);
673   a.mainfile= 0;
674
675   /* create new cdb */
676
677   cdbfd= open(pathbuf_sfx(&rw->pbsome,".tmp"), O_WRONLY|O_CREAT|O_TRUNC, 0666);
678   if (cdbfd<0) PE("create .tmp for new cdb during compact");
679
680   r= cdb_make_start(&a.cdbm, cdbfd);
681   if (r) PE("cdb_make_start during compact");
682   cdbmaking= 1;
683
684   r= ht_forall(&rw->logincore, addto_cdb, &a);
685   if (r) PE("cdb_make_add during compact");
686
687   r= cdb_make_finish(&a.cdbm);
688   if(r) PE("cdb_make_finish during compact");
689   cdbmaking= 0;
690
691   r= fdatasync(cdbfd);  if (r) PE("fdatasync new cdb during compact");
692   r= close(cdbfd);  if (r) PE("close new cdb during compact");
693   cdbfd= -1;
694
695   r= rename(rw->pbsome.buf, pathbuf_sfx(&rw->pbother,".cdb"));
696   if (r) PE("install new .cdb during compact");
697
698   /* create new main */
699
700   a.mainfile= fopen(pathbuf_sfx(&rw->pbsome,".tmp"), "w");
701   if (!a.mainfile) PE("create .tmp for new main during compact");
702
703   r= ht_forall(&rw->logincore, addto_main, &a);
704   if (r) { rc= cht_posixerr(ip, errno, "error writing to new .main"
705                             " during compact");  goto x_rc; }
706
707   r= putc('\n', a.mainfile);
708   if (r==EOF) PE("write trailing \n to main during compact");
709   
710   r= fflush(a.mainfile);  if (r) PE("fflush new main during compact");
711   r= fdatasync(fileno(a.mainfile));
712   if (r) PE("fdatasync new main during compact");
713
714   newmainsz= ftello(a.mainfile);
715   if (newmainsz<0) PE("ftello new main during compact");
716   
717   r= fclose(a.mainfile);  if (r) PE("fclose new main during compact");
718   a.mainfile= 0;
719
720   r= rename(rw->pbsome.buf, pathbuf_sfx(&rw->pbother,".main"));
721   if (r) PE("install new .main during compact");
722
723   rw->mainsz= newmainsz;
724
725   /* done! */
726   
727   rc= infocb(ip, rw, "compact-end", "main=%luby nrecs=%ld",
728              (unsigned long)rw->mainsz, *a.reccount);
729   if (rc) goto x_rc;
730
731   return rc;
732
733 x_rc:
734   if (a.mainfile) fclose(a.mainfile);
735   if (cdbmaking) cdb_make_finish(&a.cdbm);
736   maybe_close(cdbfd);
737   remove(pathbuf_sfx(&rw->pbsome,".tmp")); /* for tidyness */
738   return rc;
739 }
740
741 /*---------- Closing ----------*/
742
743 static int compact_forclose(Tcl_Interp *ip, Rw *rw, long *reccount_r) {
744   off_t logsz;
745   int r, rc;
746
747   logsz= ftello(rw->logfile);
748   if (logsz < 0) PE("ftello logfile (during tidy close)");
749
750   rc= compact_core(ip, rw, logsz, reccount_r);  if (rc) goto x_rc;
751
752   r= remove(pathbuf_sfx(&rw->pbsome,".jrn"));
753   if (r) PE("remove .jrn (during tidy close)");
754
755   return TCL_OK;
756
757 x_rc: return rc;
758 }
759   
760 int cht_do_cdbwr_close(ClientData cd, Tcl_Interp *ip, void *rw_v) {
761   Rw *rw= rw_v;
762   int rc, rc_close;
763   long reccount= -1;
764   off_t logsz;
765
766   if (rw->autocompact) rc= compact_forclose(ip, rw, &reccount);
767   else rc= TCL_OK;
768
769   if (!rc) {
770     if (rw->logfile) {
771       logsz= ftello(rw->logfile);
772       if (logsz < 0)
773         rc= cht_posixerr(ip, errno, "ftell logfile during close info");
774       else
775         rc= infocb(ip, rw, "close", "main=%luby log=%luby",
776                    rw->mainsz, logsz);
777     } else if (reccount>=0) {
778       rc= infocb(ip, rw, "close", "main=%luby nrecs=%ld",
779                  rw->mainsz, reccount);
780     } else {
781       rc= infocb(ip, rw, "close", "main=%luby", rw->mainsz);
782     }
783   }
784   rc_close= rw_close(ip,rw);
785   if (rc_close) rc= rc_close;
786   
787   cht_tabledataid_disposing(ip, rw_v, &cdbtcl_rwdatabases);
788   TFREE(rw);
789   return rc;
790 }
791
792 /*---------- Other compaction-related entrypoints ----------*/
793
794 static int compact_keepopen(Tcl_Interp *ip, Rw *rw, int force) {
795   off_t logsz;
796   long reccount;
797   int rc, r;
798
799   logsz= ftello(rw->logfile);
800   if (logsz < 0) return cht_posixerr(ip, errno, "ftell .jrn"
801                                        " during compact check or force");
802
803   if (!force && logsz < rw->mainsz / 3 + 1000) return TCL_OK;
804   /* Test case:                    ^^^ testing best value for this
805    *   main=9690434by nrecs=122803  read all in one go
806    *  no autocompact, :    6.96user 0.68system 0:08.93elapsed
807    *  auto, mulitplier 2:  7.10user 0.79system 0:09.54elapsed
808    *  auto, unity:         7.80user 0.98system 0:11.84elapsed
809    *  auto, divisor  2:    8.23user 1.05system 0:13.30elapsed
810    *  auto, divisor  3:    8.55user 1.12system 0:12.88elapsed
811    *  auto, divisor  5:    9.95user 1.43system 0:15.72elapsed
812    */
813
814   rc= compact_core(ip, rw, logsz, &reccount);  if (rc) goto x_rc;
815
816   maybe_close(rw->cdb_fd);
817   rw->cdb_fd= -1;
818   ht_destroy(&rw->logincore);
819   ht_setup(&rw->logincore);
820
821   rw->cdb_fd= open(pathbuf_sfx(&rw->pbsome,".cdb"), O_RDONLY);
822   if (rw->cdb_fd < 0) PE("reopen .cdb after compact");
823
824   rc= cdbinit(ip, rw);  if (rc) goto x_rc;
825
826   rw->logfile= fopen(pathbuf_sfx(&rw->pbsome,".jrn"), "w");
827   if (!rw->logfile) PE("reopen .jrn after compact");
828
829   r= fsync(fileno(rw->logfile));  if (r) PE("fsync .jrn after compact reopen");
830
831   return TCL_OK;
832
833 x_rc:
834   /* doom! all updates fail after this (because rw->logfile is 0), and
835    * we may be using a lot more RAM than would be ideal.  Program will
836    * have to reopen if it really wants sanity. */
837   return rc;
838 }
839
840 int cht_do_cdbwr_compact_force(ClientData cd, Tcl_Interp *ip, void *rw_v) {
841   return compact_keepopen(ip, rw_v, 1);
842 }
843 int cht_do_cdbwr_compact_check(ClientData cd, Tcl_Interp *ip, void *rw_v) {
844   return compact_keepopen(ip, rw_v, 0);
845 }
846
847 int cht_do_cdbwr_compact_explicit(ClientData cd, Tcl_Interp *ip, void *rw_v) {
848   Rw *rw= rw_v;
849   rw->autocompact= 0;
850   return TCL_OK;
851 }
852 int cht_do_cdbwr_compact_auto(ClientData cd, Tcl_Interp *ip, void *rw_v) {
853   Rw *rw= rw_v;
854   rw->autocompact= 1;
855   return TCL_OK;
856 }
857
858 /*---------- Updateing ----------*/
859
860 static int update(Tcl_Interp *ip, Rw *rw, const char *key,
861                   const Byte *data, int dlen) {
862   HashValue *val;
863   const char *failed;
864   int rc, r;
865   off_t recstart;
866
867   if (strlen(key) >= KEYLEN_MAX)
868     return cht_staticerr(ip, "key too long", "CDB KEYOVERFLOW");
869
870   if (!rw->logfile) return cht_staticerr
871     (ip, "failure during previous compact or error recovery;"
872      " cdbwr must be closed and reopened before any further updates",
873      "CDB BROKEN");
874   
875   recstart= ftello(rw->logfile);
876   if (recstart < 0)
877     return cht_posixerr(ip, errno, "failed to ftello .jrn during update");
878
879   val= htv_prep(dlen);  assert(val);
880   memcpy(htv_fillptr(val), data, dlen);
881
882   r= writerecord(rw->logfile, key, val);
883   if (!r) r= fflush(rw->logfile);
884   if (r) PE("write update to logfile");
885
886   ht_update(&rw->logincore, key, val);
887
888   if (!rw->autocompact) return TCL_OK;
889   return compact_keepopen(ip, rw, 0);
890
891  x_rc:
892   TFREE(val);
893   assert(rc);
894
895   /* Now, we have to try to sort out the journal so that it's
896    * truncated and positioned to where this abortively-written record
897    * started, with no buffered output and the error indicator clear.
898    *
899    * There seems to be no portable way to ensure the buffered unwritten
900    * output is discarded, so we close and reopen the stream.
901    */
902   fclose(rw->logfile);
903
904   rw->logfile= fopen(pathbuf_sfx(&rw->pbsome,".jrn"), "r+");
905   if (!rw->logfile) { failed= "fopen"; goto reset_fail; }
906
907   r= ftruncate(fileno(rw->logfile), recstart);
908   if (r) { failed= "ftruncate"; goto reset_fail; }
909
910   r= fseeko(rw->logfile, recstart, SEEK_SET);
911   if (r) { failed= "fseeko"; goto reset_fail; }
912
913   return rc;
914
915  reset_fail:
916   Tcl_AppendResult(ip, " (additionally, ", failed, " failed"
917                    " in error recovery: ", strerror(errno), ")", (char*)0);
918   if (rw->logfile) { fclose(rw->logfile); rw->logfile= 0; }
919
920   return rc;
921 }  
922
923 int cht_do_cdbwr_update(ClientData cd, Tcl_Interp *ip,
924                         void *rw_v, const char *key, Tcl_Obj *value) {
925   int dlen;
926   const char *data;
927   data= Tcl_GetStringFromObj(value, &dlen);  assert(data);
928   return update(ip, rw_v, key, data, dlen);
929 }
930
931 int cht_do_cdbwr_update_hb(ClientData cd, Tcl_Interp *ip,
932                            void *rw_v, const char *key, HBytes_Value value) {
933   return update(ip, rw_v, key, cht_hb_data(&value), cht_hb_len(&value));
934 }
935
936 int cht_do_cdbwr_delete(ClientData cd, Tcl_Interp *ip, void *rw_v,
937                         const char *key) {
938   return update(ip, rw_v, key, 0, 0);
939 }
940
941 /*---------- Lookups ----------*/
942
943 static int lookup_rw(Tcl_Interp *ip, void *rw_v, const char *key,
944                     const Byte **data_r, int *len_r /* -1 => notfound */) {
945   Rw *rw= rw_v;
946   const HashValue *val;
947
948   val= ht_lookup(&rw->logincore, key);
949   if (val) {
950     if (val->len) { *data_r= val->data; *len_r= val->len; return TCL_OK; }
951     else { *data_r= 0; *len_r= -1; return TCL_OK; }
952   }
953
954   return cht_cdb_lookup_cdb(ip, &rw->cdb, key, strlen(key), data_r, len_r);
955
956
957 int cht_do_cdbwr_lookup(ClientData cd, Tcl_Interp *ip, void *rw_v,
958                         const char *key, Tcl_Obj *def,
959                         Tcl_Obj **result) {
960   const Byte *data;
961   int dlen, r;
962   
963   r= lookup_rw(ip, rw_v, key, &data, &dlen);  if (r) return r;
964   return cht_cdb_donesomelookup(ip, rw_v, def, result, data, dlen,
965                                 cht_cdb_storeanswer_string);
966 }
967   
968 int cht_do_cdbwr_lookup_hb(ClientData cd, Tcl_Interp *ip, void *rw_v,
969                            const char *key, Tcl_Obj *def,
970                            Tcl_Obj **result) {
971   const Byte *data;
972   int dlen, r;
973   
974   r= lookup_rw(ip, rw_v, key, &data, &dlen);  if (r) return r;
975   return cht_cdb_donesomelookup(ip, rw_v, def, result, data, dlen,
976                                 cht_cdb_storeanswer_hb);
977 }