CP-308253 & CP-50001: Instruments Message-switch process and xapi_xenops.ml

ocaml/xapi-idl/lib/debug_info.ml

@@ -76,13 +76,14 @@ let to_log_string t = t.log
 
 (* Sets the logging context based on `dbg`.
    Also adds a new tracing span, linked to the parent span from `dbg`, if available. *)
-let with_dbg ?(with_thread = false) ?(module_name = "") ~name ~dbg f =
+let with_dbg ?attributes ?(with_thread = false) ?(module_name = "") ~name ~dbg f
+    =
   let di = of_string dbg in
   let f_with_trace () =
     let name =
       match module_name with "" -> name | _ -> module_name ^ "." ^ name
     in
-    Tracing.with_tracing ~parent:di.tracing ~name (fun span ->
+    Tracing.with_tracing ?attributes ~parent:di.tracing ~name (fun span ->
         match span with Some _ -> f {di with tracing= span} | None -> f di
     )
   in

ocaml/xapi-idl/lib/debug_info.mli

@@ -23,7 +23,8 @@ val to_string : t -> string
 val to_log_string : t -> string
 
 val with_dbg :
-     ?with_thread:bool
+     ?attributes:(string * string) list
+  -> ?with_thread:bool
   -> ?module_name:string
   -> name:string
   -> dbg:string

ocaml/xapi/context.ml

@@ -532,11 +532,12 @@ let with_forwarded_task ?http_other_config ?session_id ?origin task_id f =
   in
   finally_destroy_context ~__context f
 
-let with_tracing ?originator ~__context name f =
+let with_tracing ?(attributes = []) ?originator ~__context name f =
   let open Tracing in
   let parent = __context.tracing in
   let span_attributes =
     Attributes.attr_of_originator originator
+    @ attributes
     @ make_attributes ~task_id:__context.task_id
         ?session_id:__context.session_id ()
   in

ocaml/xapi/context.mli

@@ -185,6 +185,11 @@ val with_forwarded_task :
     then ensure [__context] is destroyed.*)
 
 val with_tracing :
-  ?originator:string -> __context:t -> string -> (t -> 'a) -> 'a
+     ?attributes:(string * string) list
+  -> ?originator:string
+  -> __context:t
+  -> string
+  -> (t -> 'a)
+  -> 'a
 
 val set_client_span : t -> Tracing.Span.t option