From a25b63f642ba2899e1c93e42197ab63246a46b3d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= <edwin.torok@cloud.com>
Date: Thu, 28 Nov 2024 09:55:33 +0000
Subject: [PATCH] CP-52821: Xapi_event: use Clock.Timer instead of gettimeofday
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Signed-off-by: Edwin Török <edwin.torok@cloud.com>
---
 ocaml/xapi/xapi_event.ml | 37 +++++++++++++++++++++++--------------
 1 file changed, 23 insertions(+), 14 deletions(-)

diff --git a/ocaml/xapi/xapi_event.ml b/ocaml/xapi/xapi_event.ml
index 19fb2b0199..9c35f86114 100644
--- a/ocaml/xapi/xapi_event.ml
+++ b/ocaml/xapi/xapi_event.ml
@@ -419,20 +419,24 @@ 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_periodic_scheduler.add_to_queue timeoutname
-            Xapi_periodic_scheduler.OneShot
-            (deadline -. Unix.gettimeofday () +. 0.5)
-            (fun () -> Condition.broadcast c) ;
-          Condition.wait c m ;
-          Xapi_periodic_scheduler.remove_from_queue timeoutname
+          match Clock.Timer.remaining timer with
+          | Expired _ ->
+              ()
+          | Remaining delta ->
+              Xapi_periodic_scheduler.add_to_queue_span timeoutname
+                Xapi_periodic_scheduler.OneShot delta (fun () ->
+                  Condition.broadcast c
+              ) ;
+              Condition.wait c m ;
+              Xapi_periodic_scheduler.remove_from_queue timeoutname
         done
     ) ;
     if session_is_invalid call then (
@@ -506,7 +510,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 +609,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 +709,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