CP-52821: Xapi_event: use Clock.Timer instead of gettimeofday

Signed-off-by: Edwin Török <[email protected]>

Author: edwintorok

ocaml/xapi/xapi_event.ml

@@ -419,20 +419,25 @@ module From = struct
 
   let session_is_invalid call = with_lock call.m (fun () -> call.session_invalid)
 
-  let wait2 call from_id deadline =
+  let wait2 call from_id timer =
     let timeoutname = Printf.sprintf "event_from_timeout_%Ld" call.index in
     with_lock m (fun () ->
         while
           from_id = call.cur_id
           && (not (session_is_invalid call))
-          && Unix.gettimeofday () < deadline
+          && not (Clock.Timer.has_expired timer)
         do
-          Xapi_stdext_threads_scheduler.Scheduler.add_to_queue timeoutname
-            Xapi_stdext_threads_scheduler.Scheduler.OneShot
-            (deadline -. Unix.gettimeofday () +. 0.5)
-            (fun () -> Condition.broadcast c) ;
-          Condition.wait c m ;
-          Xapi_stdext_threads_scheduler.Scheduler.remove_from_queue timeoutname
+          match Clock.Timer.remaining timer with
+          | Expired _ ->
+              ()
+          | Remaining delta ->
+              Xapi_stdext_threads_scheduler.Scheduler.add_to_queue_span
+                timeoutname Xapi_stdext_threads_scheduler.Scheduler.OneShot
+                delta (fun () -> Condition.broadcast c
+              ) ;
+              Condition.wait c m ;
+              Xapi_stdext_threads_scheduler.Scheduler.remove_from_queue
+                timeoutname
         done
     ) ;
     if session_is_invalid call then (
@@ -506,7 +511,7 @@ let rec next ~__context =
   else
     rpc_of_events relevant
 
-let from_inner __context session subs from from_t deadline =
+let from_inner __context session subs from from_t timer =
   let open Xapi_database in
   let open From in
   (* The database tables involved in our subscription *)
@@ -605,14 +610,14 @@ let from_inner __context session subs from from_t deadline =
             && mods = []
             && deletes = []
             && messages = []
-            && Unix.gettimeofday () < deadline
+            && not (Clock.Timer.has_expired timer)
           then (
             last_generation := last ;
             (* Cur_id was bumped, but nothing relevent fell out of the db. Therefore the *)
             sub.cur_id <- last ;
             (* last id the client got is equivalent to the current one *)
             last_msg_gen := msg_gen ;
-            wait2 sub last deadline ;
+            wait2 sub last timer ;
             Thread.delay 0.05 ;
             grab_nonempty_range ()
           ) else
@@ -705,14 +710,19 @@ let from ~__context ~classes ~token ~timeout =
         )
   in
   let subs = List.map Subscription.of_string classes in
-  let deadline = Unix.gettimeofday () +. timeout in
+  let duration =
+    timeout
+    |> Clock.Timer.s_to_span
+    |> Option.value ~default:Mtime.Span.(24 * hour)
+  in
+  let timer = Clock.Timer.start ~duration in
   (* We need to iterate because it's possible for an empty event set
      	   to be generated if we peek in-between a Modify and a Delete; we'll
      	   miss the Delete event and fail to generate the Modify because the
      	   snapshot can't be taken. *)
   let rec loop () =
-    let event_from = from_inner __context session subs from from_t deadline in
-    if event_from.events = [] && Unix.gettimeofday () < deadline then (
+    let event_from = from_inner __context session subs from from_t timer in
+    if event_from.events = [] && not (Clock.Timer.has_expired timer) then (
       debug "suppressing empty event.from" ;
       loop ()
     ) else