Add interface for flush spans and exit the export thread

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