# HG changeset patch
# User Phil Pennock <address@hidden>
# Date 1338350421 14400
# Node ID 5f5e3980e3b3590ac52745e67ff649c8dd9bd7ac
# Parent  8fcedf0ead3528b5cef8e42ece8168d82e75cbfc
Use unique timestamps for keydb

diff --git a/Makefile b/Makefile
--- a/Makefile
+++ b/Makefile
@@ -75,7 +75,8 @@ ROBJS.bc= settings.cmo pstyle.cmo getfil
 	fqueue.cmo prefixTree.cmo msgContainer.cmo \
 	nbMsgContainer.cmo cMarshal.cmo reconMessages.cmo \
 	server.cmo client.cmo reconCS.cmo \
-	number_test.cmo decode_test.cmo poly_test.cmo
+	number_test.cmo decode_test.cmo poly_test.cmo \
+	timeUnique.cmo
 ROBJS=$(ROBJS.bc:.cmo=.cmx)
 
 OBJS.bc=packet.cmo parsePGP.cmo sStream.cmo bdbwrap.cmo \
diff --git a/keydb.ml b/keydb.ml
--- a/keydb.ml
+++ b/keydb.ml
@@ -38,6 +38,7 @@ module Set = PSet.Set
 
 open Bdb
 open Packet
+open TimeUnique
 
 type dbsettings = { withtxn: bool;
 		    cache_bytes: int option;
@@ -845,7 +846,7 @@ struct
     let dbs = get_dbs () in
     let c = Cursor.create ~txn dbs.tqueue in
     let run () = 
-      let timestr = float_to_string (Unix.gettimeofday ()) in
+      let timestr = float_to_string (getuniquetimeofday ()) in
       Cursor.kput c ~key:timestr ~data:(key_to_string key) Cursor.KEYLAST
     in
     protect ~f:run ~finally:(fun () -> Cursor.close c)
@@ -890,7 +891,7 @@ struct
       md_words = Key.to_words key;
       md_keyid = keyid;
       md_subkey_keyids = subkey_keyids;
-      md_time = Unix.gettimeofday ();
+      md_time = getuniquetimeofday ();
       md_skey = shorten_offset offset;
     }
 
@@ -900,7 +901,7 @@ struct
       md_words = Key.to_words key;
       md_keyid = keyid;
       md_subkey_keyids = subkey_keyids;
-      md_time = Unix.gettimeofday ();
+      md_time = getuniquetimeofday ();
       md_skey = Offset offset;
     }
 
@@ -912,7 +913,7 @@ struct
       md_words = Key.to_words key;
       md_keyid = keyid;
       md_subkey_keyids = subkey_keyids;
-      md_time = Unix.gettimeofday ();
+      md_time = getuniquetimeofday ();
       md_skey = Key key;
     }
 
diff --git a/timeUnique.ml b/timeUnique.ml
new file mode 100644
--- /dev/null
+++ b/timeUnique.ml
@@ -0,0 +1,30 @@
+(* An interface to Unix.gettimeofday() which enforces that time always goes
+ * up and never repeats. *)
+
+let most_recent_unique_time : float ref  = ref 0.
+
+(* gettimeofday() returns seconds & microseconds, so minimum meaningful
+ * increment is 1 microsecond; OCaml uses IEEE 754 double-precision floats,
+ * which gives 53 bits of mantissa.  Assuming 32 bits for time until 32-bit
+ * time_t overflows, we can knock bits off 21 bits depending upon when we want
+ * the overflow/rollover to occur, and whatever's left is available for delta
+ * even at the end of the lifetime of the code; as that fateful day approaches,
+ * lower the granularity of this delay accordly  *)
+
+(* we don't use epsilon_float, as that's only guaranteed to give a different
+ * result when added to 1.0, not for other numbers. *)
+
+let timestamp_delta = 0.000001
+
+(* If wallclock time goes backwards, we won't, but time will appear to go
+ * forward very very slowly until wallclock catches back up *)
+
+let getuniquetimeofday nil =
+  let candidate = Unix.gettimeofday() in
+  let final =
+    match candidate > !most_recent_unique_time with
+      true -> candidate
+    | false -> !most_recent_unique_time +. timestamp_delta
+  in
+  most_recent_unique_time := final;
+  final