chiark / gitweb /
compilation fixes
[chiark-tcl.git] / cdb / writeable.c
1 /**/
2
3 #include "chiark_tcl_cdb.h"
4
5 #define ftello ftell
6 #define fseeko fseek
7
8 /*---------- Forward declarations ----------*/
9
10 struct ht_forall_ctx;
11
12 /*---------- Useful routines ----------*/
13
14 static void maybe_close(int fd) {
15   if (fd>=0) close(fd);
16 }
17
18 #define PE(m) do{                                               \
19     rc= cht_posixerr(ip, errno, "failed to " m); goto x_rc;     \
20   }while(0)
21
22 /*==================== Subsystems and subtypes ====================*/
23
24 /*---------- Pathbuf ----------*/
25
26 typedef struct Pathbuf {
27   char *buf, *sfx;
28 } Pathbuf;
29
30 #define MAX_SUFFIX 4
31
32 static void pathbuf_init(Pathbuf *pb, const char *pathb) {
33   int l= strlen(pathb);
34   pb->buf= TALLOC(l + 4);
35   memcpy(pb->buf, pathb, l);
36   pb->sfx= pb->buf + l;
37   *pb->sfx++= '.';
38 }
39 static const char *pathbuf_sfx(Pathbuf *pb, const char *suffix) {
40   assert(strlen(suffix) <= MAX_SUFFIX);
41   strcpy(pb->sfx, suffix);
42   return pb->buf;
43 }
44 static void pathbuf_free(Pathbuf *pb) {
45   TFREE(pb->buf);
46   pb->buf= 0;
47 }
48
49 /*---------- Our hash table ----------*/
50
51 typedef struct HashTable {
52   Tcl_HashTable t;
53   Byte padding[128]; /* allow for expansion by Tcl, urgh */
54   Byte confound[16];
55 } HashTable;
56
57 typedef struct HashValue {
58   int len;
59   Byte data[1];
60 } HashValue;
61
62 static HashValue *htv_prep(int len) {
63   HashValue *hd;
64   hd= TALLOC((hd->data - (Byte*)hd) + len);
65   hd->len= len;
66   return hd;
67 }  
68 static Byte *htv_fillptr(HashValue *hd) {
69   return hd->data;
70 }
71 #if 0
72 static void htv_fill(HashValue *hd, const Byte *data) {
73   memcpy(hd->data, data, hd->len);
74 }
75 #endif
76
77 static void ht_setup(HashTable *ht) {
78   Tcl_InitHashTable(&ht->t, TCL_STRING_KEYS);
79 }
80 static void ht_update(HashTable *ht, const char *key, HashValue *val_eat) {
81   Tcl_HashEntry *he;
82   int new;
83
84   he= Tcl_CreateHashEntry(&ht->t, (char*)key, &new);
85   if (!new) TFREE(Tcl_GetHashValue(he));
86   Tcl_SetHashValue(he, val_eat);
87     /* eats the value since the data structure owns the memory */
88 }
89 static void ht_maybeupdate(HashTable *ht, const char *key,
90                            HashValue *val_eat) {
91   /* like ht_update except does not overwrite existing values */
92   Tcl_HashEntry *he;
93   int new;
94
95   he= Tcl_CreateHashEntry(&ht->t, (char*)key, &new);
96   if (!new) { TFREE(val_eat); return; }
97   Tcl_SetHashValue(he, val_eat);
98 }
99
100 static int ht_forall(HashTable *ht,
101                      int (*fn)(const char *key, HashValue *val,
102                                struct ht_forall_ctx *ctx),
103                      struct ht_forall_ctx *ctx) {
104   /* Returns first positive value returned by any call to fn, or 0. */
105   Tcl_HashSearch sp;
106   Tcl_HashEntry *he;
107   const char *key;
108   HashValue *val;
109   int r;
110   
111   for (he= Tcl_FirstHashEntry(&ht->t, &sp);
112        he;
113        he= Tcl_NextHashEntry(&sp)) {
114     val= Tcl_GetHashValue(he);
115     if (!val->len) continue;
116
117     key= Tcl_GetHashKey(&ht->t, he);
118     
119     r= fn(key, val, ctx);
120     if (r) return r;
121   }
122   return 0;
123 }
124
125 static void ht_destroy(HashTable *ht) {
126   Tcl_HashSearch sp;
127   Tcl_HashEntry *he;
128   
129   for (he= Tcl_FirstHashEntry(&ht->t, &sp);
130        he;
131        he= Tcl_NextHashEntry(&sp)) {
132     /* ht_forall skips empty (deleted) entries so is no good for this */
133     TFREE(Tcl_GetHashValue(he));
134   }
135   Tcl_DeleteHashTable(&ht->t);
136 }
137
138 /*==================== Existential ====================*/
139
140 /*---------- Rw data structure ----------*/
141
142 typedef struct Rw {
143   int ix, autocompact;
144   int cdb_fd, lock_fd;
145   struct cdb cdb; /* valid iff cdb_fd >= 0 */
146   FILE *logfile;
147   HashTable logincore;
148   Pathbuf pbsome, pbother;
149   off_t mainsz;
150   ScriptToInvoke on_info, on_lexminval;
151 } Rw;
152
153 static int rw_close(Tcl_Interp *ip, Rw *rw) {
154   int rc, r;
155
156   rc= TCL_OK;
157   ht_destroy(&rw->logincore);
158   if (rw->cdb_fd >= 0) cdb_free(&rw->cdb);
159   maybe_close(rw->cdb_fd);
160   maybe_close(rw->lock_fd);
161
162   if (rw->logfile) {
163     r= fclose(rw->logfile);
164     if (r && ip) { rc= cht_posixerr(ip, errno, "probable data loss! failed to"
165                                     " fclose logfile during untidy close"); }
166   }
167
168   pathbuf_free(&rw->pbsome); pathbuf_free(&rw->pbother);
169   TFREE(rw);
170   return rc;
171 }
172
173 static void destroy_cdbrw_idtabcb(Tcl_Interp *ip, void *rw) { rw_close(0,rw); }
174 const IdDataSpec cdbtcl_rwdatabases= {
175   "cdb-rwdb", "cdb-openrwdatabases-table", destroy_cdbrw_idtabcb
176 };
177
178 /*---------- File handling ----------*/
179
180 static int acquire_lock(Tcl_Interp *ip, Pathbuf *pb, int *lockfd_r) {
181   /* *lockfd_r must be -1 on entry.  If may be set to >=0 even
182    * on error, and must be closed by the caller. */
183   mode_t um, lockmode;
184   struct flock fl;
185   int r;
186
187   um= umask(~(mode_t)0);
188   umask(um);
189
190   lockmode= 0666 & ~((um & 0444)>>1);
191   /* Remove r where umask would remove w;
192    * eg umask intending 0664 here gives 0660 */
193   
194   *lockfd_r= open(pathbuf_sfx(pb,".lock"), O_RDONLY|O_CREAT, lockmode);
195   if (*lockfd_r < 0)
196     return cht_posixerr(ip, errno, "could not open/create lockfile");
197
198   fl.l_type= F_WRLCK;
199   fl.l_whence= SEEK_SET;
200   fl.l_start= 0;
201   fl.l_len= 0;
202   fl.l_pid= getpid();
203
204   r= fcntl(*lockfd_r, F_SETLK, &fl);
205   if (r == -1) {
206     if (errno == EACCES || errno == EAGAIN)
207       return cht_staticerr(ip, "lock held by another process", "CDB LOCKED");
208     else return cht_posixerr(ip, errno, "unexpected error from fcntl while"
209                              " acquiring lock");
210   }
211
212   return TCL_OK;
213 }
214
215 /*---------- Log reading ----------*/
216
217 static int readlognum(FILE *f, int delim, int *num_r) {
218   int c;
219   char numbuf[20], *p, *ep;
220   unsigned long ul;
221
222   p= numbuf;
223   for (;;) {
224     c= getc(f);  if (c==EOF) return -2;
225     if (c == delim) break;
226     if (!isdigit((unsigned char)c)) return -2;
227     *p++= c;
228     if (p == numbuf+sizeof(numbuf)) return -2;
229   }
230   if (p == numbuf) return -2;
231   *p= 0;
232
233   errno=0; ul= strtoul(numbuf, &ep, 10);
234   if (*ep || errno || ul >= INT_MAX/2) return -2;
235   *num_r= ul;
236   return 0;
237 }
238
239 static int readstorelogrecord(FILE *f, HashTable *ht,
240                               int (*omitfn)(const HashValue*,
241                                             struct ht_forall_ctx *ctx),
242                               struct ht_forall_ctx *ctx,
243                               void (*updatefn)(HashTable*, const char*,
244                                                HashValue*)) {
245   /* returns:
246    *      0     for OK
247    *     -1     eof
248    *     -2     corrupt or error
249    *     -3     got newline indicating end
250    *     >0     value from omitfn
251    */
252   int keylen, vallen;
253   char *key;
254   HashValue *val;
255   int c, rc, r;
256
257   c= getc(f);
258   if (c==EOF) { if (feof(f)) return -1; return -2; }
259   if (c=='\n') return -3;
260   if (c!='+') return -2;
261
262   rc= readlognum(f, ',', &keylen);  if (rc) return rc;
263   rc= readlognum(f, ':', &vallen);  if (rc) return rc;
264
265   key= TALLOC(keylen+1);
266   val= htv_prep(vallen);
267
268   r= fread(key, 1,keylen, f);
269   if (r!=keylen) goto x2_free_keyval;
270   if (memchr(key,0,keylen)) goto x2_free_keyval;
271   key[keylen]= 0;
272
273   c= getc(f);  if (c!='-') goto x2_free_keyval;
274   c= getc(f);  if (c!='>') goto x2_free_keyval;
275   
276   r= fread(htv_fillptr(val), 1,vallen, f);
277   if (r!=vallen) goto x2_free_keyval;
278
279   rc= omitfn ? omitfn(val, ctx) : TCL_OK;
280   if (rc) { assert(rc>0); TFREE(val); }
281   else updatefn(ht, key, val);
282   
283   TFREE(key);
284   return rc;
285
286  x2_free_keyval:
287   TFREE(val);
288   TFREE(key);
289   return -2;
290 }
291
292 /*---------- Creating ----------*/
293
294 int cht_do_cdbwr_create_empty(ClientData cd, Tcl_Interp *ip,
295                               const char *pathb) {
296   static const char *const toremoves[]= {
297     ".main", ".cdb", ".log", ".tmp", 0
298   };
299
300   Pathbuf pb;
301   int lock_fd=-1, fd=-1, rc, r;
302   const char *const *toremove;
303
304   pathbuf_init(&pb, pathb);
305   rc= acquire_lock(ip, &pb, &lock_fd);  if (rc) goto x_rc;
306   
307   fd= open(pathbuf_sfx(&pb, ".main"), O_RDWR|O_CREAT|O_EXCL, 0666);
308   if (fd <= 0) PE("create new database file");
309
310   for (toremove=toremoves; *toremove; toremove++) {
311     r= remove(*toremove);
312     if (r && errno != ENOENT)
313       PE("delete possible spurious file during creation");
314   }
315   
316   rc= TCL_OK;
317
318  x_rc:
319   maybe_close(fd);
320   maybe_close(lock_fd);
321   pathbuf_free(&pb);
322   return rc;
323 }
324
325 /*---------- Info callbacks ----------*/
326
327 static int infocbv3(Tcl_Interp *ip, Rw *rw, const char *arg1,
328                     const char *arg2fmt, const char *arg3, va_list al) {
329   Tcl_Obj *aa[3];
330   int na;
331   char buf[200];
332   vsnprintf(buf, sizeof(buf), arg2fmt, al);
333
334   na= 0;
335   aa[na++]= cht_ret_string(ip, arg1);
336   aa[na++]= cht_ret_string(ip, buf);
337   if (arg3) aa[na++]= cht_ret_string(ip, arg3);
338   
339   return cht_scriptinv_invoke_fg(&rw->on_info, na, aa);
340 }
341   
342 static int infocb3(Tcl_Interp *ip, Rw *rw, const char *arg1,
343                    const char *arg2fmt, const char *arg3, ...) {
344   int rc;
345   va_list al;
346   va_start(al, arg3);
347   rc= infocbv3(ip,rw,arg1,arg2fmt,arg3,al);
348   va_end(al);
349   return rc;
350 }
351   
352 static int infocb(Tcl_Interp *ip, Rw *rw, const char *arg1,
353                   const char *arg2fmt, ...) {
354   int rc;
355   va_list al;
356   va_start(al, arg2fmt);
357   rc= infocbv3(ip,rw,arg1,arg2fmt,0,al);
358   va_end(al);
359   return rc;
360 }
361   
362 /*---------- Opening ----------*/
363
364 static int cdbinit(Tcl_Interp *ip, Rw *rw) {
365   /* On entry, cdb_fd >=0 but cdb is _undefined_/
366    * On exit, either cdb_fd<0 or cdb is initialised */
367   int r, rc;
368   
369   r= cdb_init(&rw->cdb, rw->cdb_fd);
370   if (r) {
371     rc= cht_posixerr(ip, errno, "failed to initialise cdb reader");
372     close(rw->cdb_fd);  rw->cdb_fd= -1;  return rc;
373   }
374   return TCL_OK;
375 }
376
377 int cht_do_cdbwr_open(ClientData cd, Tcl_Interp *ip, const char *pathb,
378                       Tcl_Obj *on_info, Tcl_Obj *on_lexminval,
379                       void **result) {
380   const Cdbwr_SubCommand *subcmd= cd;
381   int r, rc, mainfd=-1;
382   Rw *rw;
383   struct stat stab;
384   off_t logrecstart, logjunkpos;
385
386   rw= TALLOC(sizeof(*rw));
387   ht_setup(&rw->logincore);
388   cht_scriptinv_init(&rw->on_info);
389   cht_scriptinv_init(&rw->on_lexminval);
390   rw->cdb_fd= rw->lock_fd= -1;  rw->logfile= 0;
391   pathbuf_init(&rw->pbsome, pathb);
392   pathbuf_init(&rw->pbother, pathb);
393   rw->autocompact= 1;
394
395   if (on_lexminval) {
396     rc= cht_scriptinv_set(&rw->on_lexminval, ip, on_lexminval, 0);
397     if (rc) goto x_rc;
398   } else {
399     rw->on_lexminval.llength= 0;
400   }
401
402   mainfd= open(pathbuf_sfx(&rw->pbsome,".main"), O_RDONLY);
403   if (mainfd<0) PE("open exist3ing database file .main");
404   rc= acquire_lock(ip, &rw->pbsome, &rw->lock_fd);  if (rc) goto x_rc;
405
406   r= fstat(mainfd, &stab);  if (r) PE("fstat .main");
407   rw->mainsz= stab.st_size;
408
409   rw->cdb_fd= open(pathbuf_sfx(&rw->pbsome,".cdb"), O_RDONLY);
410   if (rw->cdb_fd >=0) {
411     rc= cdbinit(ip, rw);  if (rc) goto x_rc;
412   } else if (errno == ENOENT) {
413     if (rw->mainsz) {
414       rc= cht_staticerr(ip, ".cdb does not exist but .main is nonempty -"
415                         " .cdb must have been accidentally deleted!",
416                         "CDB CDBMISSING");
417       goto x_rc;
418     }
419     /* fine */
420   } else {
421     PE("open .cdb");
422   }
423
424   rw->logfile= fopen(pathbuf_sfx(&rw->pbsome,".log"), "r+");
425   if (!rw->logfile) {
426     if (errno != ENOENT) PE("failed to open .log during open");
427     rw->logfile= fopen(rw->pbsome.buf, "w");
428     if (!rw->logfile) PE("create .log during (clean) open");
429   } else { /* rw->logfile */
430     r= fstat(fileno(rw->logfile), &stab);
431     if (r==-1) PE("fstat .log during open");
432     rc= infocb(ip, rw, "open-dirty-start", "log=%luby",
433                (unsigned long)stab.st_size);
434     if (rc) goto x_rc;
435
436     for (;;) {
437       logrecstart= ftello(rw->logfile);
438       if (logrecstart < 0) PE("ftello .log during (dirty) open");
439       r= readstorelogrecord(rw->logfile, &rw->logincore, 0,0, ht_update);
440       if (ferror(rw->logfile)) {
441         rc= cht_posixerr(ip, errno, "error reading .log during (dirty) open");
442         goto x_rc;
443       }
444       if (r==-1) {
445         break;
446       } else if (r==-2 || r==-3) {
447         char buf[100];
448         logjunkpos= ftello(rw->logfile);
449         if(logjunkpos<0) PE("ftello .log during report of junk in dirty open");
450
451         snprintf(buf,sizeof(buf), "CDB SYNTAX LOG %lu %lu",
452                  (unsigned long)logjunkpos, (unsigned long)logrecstart);
453
454         if (!(subcmd->flags & RWSCF_OKJUNK)) {
455           Tcl_SetObjErrorCode(ip, Tcl_NewStringObj(buf,-1));
456           snprintf(buf,sizeof(buf),"%lu",(unsigned long)logjunkpos);
457           Tcl_ResetResult(ip);
458           Tcl_AppendResult(ip, "syntax error (junk) in .log during"
459                            " (dirty) open, at file position ", buf, (char*)0);
460           rc= TCL_ERROR;
461           goto x_rc;
462         }
463         rc= infocb3(ip, rw, "open-dirty-junk", "errorfpos=%luby", buf,
464                     (unsigned long)logjunkpos);
465         if (rc) goto x_rc;
466
467         r= fseeko(rw->logfile, logrecstart, SEEK_SET);
468         if (r) PE("failed to fseeko .log before junk during dirty open");
469
470         r= ftruncate(fileno(rw->logfile), logrecstart);
471         if (r) PE("ftruncate .log to chop junk during dirty open");
472       } else {
473         assert(!r);
474       }
475     }
476   }
477   /* now log is positioned for appending and everything is read */
478
479   *result= rw;
480   maybe_close(mainfd);
481   return TCL_OK;
482
483  x_rc:
484   rw_close(0,rw);
485   maybe_close(mainfd);
486   return rc;
487 }
488
489 /*==================== COMPACTION ====================*/
490
491 struct ht_forall_ctx {
492   struct cdb_make cdbm;
493   FILE *mainfile;
494   int lexminvall;
495   long *reccount;
496   const char *lexminval;
497 };
498
499 /*---------- helper functions ----------*/
500
501 static int expiredp(const HashValue *val, struct ht_forall_ctx *a) {
502   int r, l;
503   if (!val->len) return 0;
504   l= val->len < a->lexminvall ? val->len : a->lexminvall;
505   r= memcmp(val->data, a->lexminval, l);
506   if (r>0) return 0;
507   if (r<0) return 1;
508   return val->len < a->lexminvall;
509 }
510
511 static int delete_ifexpired(const char *key, HashValue *val,
512                             struct ht_forall_ctx *a) {
513   if (!expiredp(val, a)) return 0;
514   val->len= 0;
515   /* we don't actually need to realloc it to free the memory because
516    * this will shortly all be deleted as part of the compaction */
517   return 0;
518 }
519
520 static int addto_cdb(const char *key, HashValue *val,
521                      struct ht_forall_ctx *a) {
522   return cdb_make_add(&a->cdbm, key, strlen(key), val->data, val->len);
523 }
524
525 static int addto_main(const char *key, HashValue *val,
526                       struct ht_forall_ctx *a) {
527   int r;
528
529   (*a->reccount)++;
530   
531   r= fprintf(a->mainfile, "+%d,%d:%s->", strlen(key), val->len, key);
532   if (r<0) return -1;
533   
534   r= fwrite(val->data, 1, val->len, a->mainfile);
535   if (r != val->len) return -1;
536
537   return 0;
538 }
539
540 /*---------- compact main entrypoint ----------*/
541
542 static int compact_core(Tcl_Interp *ip, Rw *rw, unsigned long logsz,
543                         long *reccount_r) {
544   /* creates new .cdb and .main
545    * closes logfile
546    * leaves .log with old data
547    * leaves cdb fd open onto old db
548    * leaves logincore full of crap
549    */
550   int r, rc;
551   int cdbfd, cdbmaking;
552   off_t errpos, newmainsz;
553   char buf[100];
554   Tcl_Obj *res;
555   struct ht_forall_ctx a;
556
557   a.mainfile= 0;
558   cdbfd= -1;
559   cdbmaking= 0;
560   *reccount_r= 0;
561   a.reccount= reccount_r;
562
563   r= fclose(rw->logfile);
564   if (r) { rc= cht_posixerr(ip, errno, "probable data loss!  failed to fclose"
565                             " logfile during compact");  goto x_rc; }
566   rw->logfile= 0;
567   
568   rc= infocb(ip, rw, "compact-start", "log=%luby main=%luby",
569              logsz, (unsigned long)rw->mainsz);
570   if (rc) goto x_rc;
571
572   if (rw->on_lexminval.llength) {
573     rc= cht_scriptinv_invoke_fg(&rw->on_lexminval, 0,0);
574     if (rc) goto x_rc;
575
576     res= Tcl_GetObjResult(ip);  assert(res);
577     a.lexminval= Tcl_GetStringFromObj(res, &a.lexminvall);
578     assert(a.lexminval);
579
580     /* we rely not calling Tcl_Eval during the actual compaction;
581      * if we did Tcl_Eval then the interp result would be trashed.
582      */
583     rc= ht_forall(&rw->logincore, delete_ifexpired, &a);
584
585   } else {
586     a.lexminval= "";
587   }
588
589   /* merge unsuperseded records from main into hash table */
590
591   a.mainfile= fopen(pathbuf_sfx(&rw->pbsome,".main"), "r");
592   if (!a.mainfile) PE("failed to open .main for reading during compact");
593
594   for (;;) {
595     r= readstorelogrecord(a.mainfile, &rw->logincore,
596                           expiredp, &a,
597                           ht_maybeupdate);
598     if (ferror(a.mainfile)) { rc= cht_posixerr(ip, errno, "error reading"
599                          " .main during compact"); goto x_rc;
600     }
601     if (r==-3) {
602       break;
603     } else if (r==-1 || r==-2) {
604       errpos= ftello(a.mainfile);
605       if (errpos<0) PE("ftello .main during report of syntax error");
606       snprintf(buf,sizeof(buf), "CDB SYNTAX MAIN %lu", (unsigned long)errpos);
607       Tcl_SetObjErrorCode(ip, Tcl_NewStringObj(buf,-1));
608       snprintf(buf,sizeof(buf), "%lu", (unsigned long)errpos);
609       Tcl_ResetResult(ip);
610       Tcl_AppendResult(ip, "syntax error in .main during"
611                        " compact, at file position ", buf, (char*)0);
612       rc= TCL_ERROR;
613       goto x_rc;
614     } else {
615       assert(!rc);
616     }
617   }
618   fclose(a.mainfile);
619   a.mainfile= 0;
620
621   /* create new cdb */
622
623   cdbfd= open(pathbuf_sfx(&rw->pbsome,".tmp"), O_WRONLY|O_CREAT|O_TRUNC, 0666);
624   if (cdbfd<0) PE("create .tmp for new cdb during compact");
625
626   r= cdb_make_start(&a.cdbm, cdbfd);
627   if (r) PE("cdb_make_start during compact");
628   cdbmaking= 1;
629
630   r= ht_forall(&rw->logincore, addto_cdb, &a);
631   if (r) PE("cdb_make_add during compact");
632
633   r= cdb_make_finish(&a.cdbm);
634   if(r) PE("cdb_make_finish during compact");
635   cdbmaking= 0;
636
637   r= fdatasync(cdbfd);  if (r) PE("fdatasync new cdb during compact");
638   r= close(cdbfd);  if (r) PE("close new cdb during compact");
639   cdbfd= -1;
640
641   r= rename(rw->pbsome.buf, pathbuf_sfx(&rw->pbother,".cdb"));
642   if (r) PE("install new .cdb during compact");
643
644   /* create new main */
645
646   a.mainfile= fopen(pathbuf_sfx(&rw->pbsome,".tmp"), "w");
647   if (!a.mainfile) PE("create .tmp for new main during compact");
648
649   r= ht_forall(&rw->logincore, addto_main, &a);
650   if (r) { rc= cht_posixerr(ip, r, "error writing to new .main"
651                             " during compact");  goto x_rc; }
652   
653   r= fflush(a.mainfile);  if (r) PE("fflush new main during compact");
654   r= fdatasync(fileno(a.mainfile));
655   if (r) PE("fdatasync new main during compact");
656
657   newmainsz= ftello(a.mainfile);
658   if (newmainsz<0) PE("ftello new main during compact");
659   
660   r= fclose(a.mainfile);  if (r) PE("fclose new main during compact");
661   a.mainfile= 0;
662
663   r= rename(rw->pbsome.buf, pathbuf_sfx(&rw->pbother,".main"));
664   if (r) PE("install new .main during compact");
665
666   rw->mainsz= newmainsz;
667
668   /* done! */
669   
670   rc= infocb(ip, rw, "compact-end", "main=%luby nrecs=%l",
671              (unsigned long)rw->mainsz, *a.reccount);
672   if (rc) goto x_rc;
673
674   return rc;
675
676 x_rc:
677   if (a.mainfile) fclose(a.mainfile);
678   if (cdbmaking) cdb_make_finish(&a.cdbm);
679   maybe_close(cdbfd);
680   remove(pathbuf_sfx(&rw->pbsome,".tmp")); /* for tidyness */
681   return rc;
682 }
683
684 /*---------- Closing ----------*/
685
686 static int compact_forclose(Tcl_Interp *ip, Rw *rw, long *reccount_r) {
687   off_t logsz;
688   int r, rc;
689
690   logsz= ftello(rw->logfile);
691   if (logsz < 0) PE("ftello logfile (during tidy close)");
692
693   rc= compact_core(ip, rw, logsz, reccount_r);  if (rc) goto x_rc;
694
695   r= remove(pathbuf_sfx(&rw->pbsome,".log"));
696   if (r) PE("remove .log (during tidy close)");
697
698   return TCL_OK;
699
700 x_rc: return rc;
701 }
702   
703 int cht_do_cdbwr_close(ClientData cd, Tcl_Interp *ip, void *rw_v) {
704   Rw *rw= rw_v;
705   int rc, rc_close;
706   long reccount= -1;
707   off_t logsz;
708
709   if (rw->autocompact) rc= compact_forclose(ip, rw, &reccount);
710   else rc= TCL_OK;
711
712   if (!rc) {
713     if (!rw->logfile) {
714       logsz= ftello(rw->logfile);
715       if (logsz < 0)
716         rc= cht_posixerr(ip, errno, "ftell logfile during close info");
717       else
718         rc= infocb(ip, rw, "close", "main=%luby log=%luby",
719                    rw->mainsz, logsz);
720     } else if (reccount>=0) {
721       rc= infocb(ip, rw, "close", "main=%luby nrecs=%l", rw->mainsz, reccount);
722     } else {
723       rc= infocb(ip, rw, "close", "main=%luby", rw->mainsz);
724     }
725   }
726   rc_close= rw_close(ip,rw);
727   if (rc_close) rc= rc_close;
728   
729   cht_tabledataid_disposing(ip, rw_v, &cdbtcl_rwdatabases);
730   return rc;
731 }
732
733 /*---------- Other compaction-related entrypoints ----------*/
734
735 static int compact_keeopen(Tcl_Interp *ip, Rw *rw, int force) {
736   off_t logsz;
737   long reccount;
738   int rc, r;
739
740   logsz= ftello(rw->logfile);
741   if (logsz < 0) return cht_posixerr(ip, errno, "ftell .log"
742                                        " during compact check or force");
743
744   if (!force && logsz < rw->mainsz / 10 + 1000) return TCL_OK;
745
746   rc= compact_core(ip, rw, logsz, &reccount);  if (rc) goto x_rc;
747
748   maybe_close(rw->cdb_fd);
749   rw->cdb_fd= -1;
750   ht_destroy(&rw->logincore);
751   ht_setup(&rw->logincore);
752
753   rw->cdb_fd= open(pathbuf_sfx(&rw->pbsome,".cdb"), O_RDONLY);
754   if (rw->cdb_fd < 0) PE("reopen .cdb after compact");
755
756   rc= cdbinit(ip, rw);  if (rc) goto x_rc;
757
758   rw->logfile= fopen(pathbuf_sfx(&rw->pbsome,".log"), "w");
759   if (!rw->logfile) PE("reopen .log after compact");
760
761   r= fsync(fileno(rw->logfile));  if (r) PE("fsync .log after compact reopen");
762
763   return TCL_OK;
764
765 x_rc:
766   /* doom! all updates fail after this (because rw->logfile is 0), and
767    * we may be usin a lot more RAM than would be ideal.  Program will
768    * have to reopen if it really wants sanity. */
769   return rc;
770 }
771
772 int cht_do_cdbwr_compact_force(ClientData cd, Tcl_Interp *ip, void *rw_v) {
773   return compact_keeopen(ip, rw_v, 1);
774 }
775 int cht_do_cdbwr_compact_check(ClientData cd, Tcl_Interp *ip, void *rw_v) {
776   return compact_keeopen(ip, rw_v, 0);
777 }
778
779 int cht_do_cdbwr_compact_explicit(ClientData cd, Tcl_Interp *ip, void *rw_v) {
780   Rw *rw= rw_v;
781   rw->autocompact= 0;
782   return TCL_OK;
783 }
784 int cht_do_cdbwr_compact_auto(ClientData cd, Tcl_Interp *ip, void *rw_v) {
785   Rw *rw= rw_v;
786   rw->autocompact= 1;
787   return TCL_OK;
788 }