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