From: Richard W.M. Jones <rjones@redhat.com>
Date: Tue, 17 Sep 2013 17:14:27 +0000 (+0100)
Subject: The Memory: Don't create empty file on first write.
X-Git-Tag: 0.2~27
X-Git-Url: http://git.annexia.org/?a=commitdiff_plain;h=a613a9cb7d016e728a45b81ecdb49097832ba924;p=goaljobs.git

The Memory: Don't create empty file on first write.

This would cause all writes to fail the first time.
---

diff --git a/goaljobs.ml b/goaljobs.ml
index 48765aa..bb7141a 100644
--- a/goaljobs.ml
+++ b/goaljobs.ml
@@ -323,6 +323,18 @@ let with_memory_locked ?(write = false) f =
   let filename = getenv "HOME" // ".goaljobs-memory" in
   let fd = openfile filename [O_RDWR; O_CREAT] 0o644 in
   lockf fd (if write then F_LOCK else F_RLOCK) 0;
+  (* If the file is newly created with zero size, write an
+   * empty hash table.
+   *)
+  if (fstat fd).st_size = 0 then (
+    let empty : (string, string) Hashtbl.t = Hashtbl.create 13 in
+    let chan = out_channel_of_descr fd in
+    output_value chan empty;
+    Pervasives.flush chan;
+    ignore (lseek fd 0 SEEK_SET)
+  );
+
+  (* Run the function. *)
   let r = try Either (f fd) with exn -> Or (exn) in
   lockf fd F_ULOCK 0;
   match r with
@@ -353,7 +365,8 @@ let memory_set key value =
       Hashtbl.replace memory key value;
       let chan = out_channel_of_descr fd in
       seek_out chan 0;
-      output_value chan memory
+      output_value chan memory;
+      Pervasives.flush chan;
   )
 
 let memory_delete key =
@@ -364,7 +377,8 @@ let memory_delete key =
       Hashtbl.remove memory key;
       let chan = out_channel_of_descr fd in
       seek_out chan 0;
-      output_value chan memory
+      output_value chan memory;
+      Pervasives.flush chan;
   )
 
 let published_goals = ref []