CA-385278: Add interface for flush spans and exit the export thread

Currently there is no way to force flush the spans in memory, this patch
adds an interface to allow such flush. This is useful when, for example,
clusterd is about to exit.

Signed-off-by: Vincent Liu <[email protected]>

ocaml/libs/tracing/tracing.ml

@@ -13,6 +13,7 @@
  *)
 module D = Debug.Make (struct let name = "tracing" end)
 
+module Delay = Xapi_stdext_threads.Threadext.Delay
 open D
 
 type endpoint = Bugtool | Url of Uri.t
@@ -820,14 +821,23 @@ module Export = struct
       |> List.concat_map (fun x -> TracerProvider.get_endpoints x)
       |> List.iter (export_to_endpoint parent span_list)
 
+    let delay = Delay.make ()
+
+    (* Note this signal will flush the spans and terminate the exporter thread *)
+    let signal () = Delay.signal delay
+
     let create_exporter () =
       enable_span_garbage_collector () ;
       Thread.create
         (fun () ->
-          while true do
+          let signaled = ref false in
+          while not !signaled do
             debug "Tracing: Waiting %d seconds before exporting spans"
               (int_of_float !export_interval) ;
-            Thread.delay !export_interval ;
+            if not (Delay.wait delay !export_interval) then (
+              debug "Tracing: we are signaled, export spans now and exit" ;
+              signaled := true
+            ) ;
             flush_spans ()
           done
         )
@@ -850,6 +860,6 @@ module Export = struct
   end
 end
 
-let main = Export.Destination.main
+let flush_and_exit = Export.Destination.signal
 
-let flush_spans = Export.Destination.flush_spans
+let main = Export.Destination.main

ocaml/libs/tracing/tracing.mli

@@ -152,6 +152,6 @@ val set_observe : bool -> unit
 
 val validate_attribute : string * string -> bool
 
-val flush_spans : unit -> unit
+val flush_and_exit : unit -> unit
 
 val main : unit -> Thread.t