CP-46377: Add env vars TRACEPARENT & OBSERVER_CONFIG_DIR to exec_xmlrpc calls

ocaml/forkexecd/lib/forkhelpers.ml

@@ -23,6 +23,8 @@
 
 let default_path = ["/sbin"; "/usr/sbin"; "/bin"; "/usr/bin"]
 
+let default_path_env_pair = [|"PATH=" ^ String.concat ":" default_path|]
+
 (* /var/ may not be writable when testing, use XDG_RUNTIME_DIR instead in that
    case. Avoid changing the directory unless the code is being tested. *)
 let test_path =
@@ -182,13 +184,7 @@ let safe_close_and_exec ?env stdin stdout stderr
         List.fold_left maybe_add_id_to_fd_map dest_named_fds predefined_fds
       in
 
-      let env =
-        match env with
-        | Some e ->
-            e
-        | None ->
-            [|"PATH=" ^ String.concat ":" default_path|]
-      in
+      let env = match env with Some e -> e | None -> default_path_env_pair in
       let syslog_stdout =
         match syslog_stdout with
         | NoSyslogging ->

ocaml/forkexecd/lib/forkhelpers.mli

@@ -41,6 +41,8 @@ type syslog_stdout_t =
 
 val default_path : string list
 
+val default_path_env_pair : string array
+
 val execute_command_get_output :
      ?env:string array
   -> ?syslog_stdout:syslog_stdout_t

ocaml/libs/tracing/tracing.ml

@@ -152,6 +152,8 @@ module SpanContext = struct
         Some {trace_id; span_id}
     | _ ->
         None
+
+  let trace_id_of_span_context t = t.trace_id
 end
 
 module SpanLink = struct

ocaml/libs/tracing/tracing.mli

@@ -46,6 +46,8 @@ module SpanContext : sig
   val to_traceparent : t -> string
 
   val of_traceparent : string -> t option
+
+  val trace_id_of_span_context : t -> string
 end
 
 module Span : sig

ocaml/xapi-aux/env_record.ml

@@ -0,0 +1,30 @@
+(*
+ * Copyright (C) 2023 Cloud Software Group
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+type t = string
+
+let str txt = txt
+
+let option opt = Option.value ~default:"" opt
+
+let list element lst = List.map element lst |> String.concat ","
+
+let pair (key, value) = String.concat "=" [key; value]
+
+let to_shell_string lst =
+  lst
+  |> List.map (fun (key, value) -> String.concat "=" [key; Filename.quote value])
+  |> String.concat "\n"
+
+let to_string_array = Array.of_list

ocaml/xapi-aux/env_record.mli

@@ -0,0 +1,51 @@
+(*
+ * Copyright (C) 2023 Cloud Software Group
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+(** A Unix environment variable is a pair of a name and a value, both of which 
+  * are strings. This module helps to construct a complex environment value 
+  * that follows specific conventions.
+  *)
+
+(** A value of type [t] represents a value. 
+  * It is constructed recursively from OCaml values using functions like [str], 
+  * [option], or [list]. An environment value of type [t] can be observed using 
+  * [to_shell_string] or [to_string_array].
+  *)
+type t
+
+val str : string -> t
+(** Returns an environment variable value from a string.
+  *)
+
+val option : string option -> t
+(** Returns an environment variable value from a string option.
+  * If [None], returns an empty string value.
+  *)
+
+val list : ('a -> t) -> 'a list -> t
+(** [list element lst] is the list [lst] with elements converted by [element] 
+  * and separated by [,]. 
+  *)
+
+val pair : string * string -> t
+(** [pair (key, value)] is [key=value] pair. *)
+
+val to_shell_string : (string * t) list -> string
+(** [to_shell_string env_vars] is [env_vars] quoted as needed for use in a shell 
+  * script.
+  *)
+
+val to_string_array : t list -> string array
+(** Transforms a list of environment variables to a string array of environment 
+  * variables.*)

ocaml/xapi-idl/lib/debuginfo.ml

@@ -65,3 +65,11 @@ let with_dbg ?(with_thread = false) ~module_name ~name ~dbg f =
       Debug.with_thread_associated di.log f_with_trace ()
   | false ->
       f_with_trace ()
+
+let span_context_of_di di =
+  Option.map (fun span -> Tracing.Span.get_context span) di.tracing
+
+let traceparent_of_dbg dbg =
+  of_string dbg
+  |> span_context_of_di
+  |> Option.map Tracing.SpanContext.trace_id_of_span_context

ocaml/xapi-idl/lib/debuginfo.mli

@@ -29,3 +29,5 @@ val with_dbg :
   -> dbg:string
   -> (t -> 'a)
   -> 'a
+
+val traceparent_of_dbg : string -> string option

ocaml/xapi/sm_exec.ml

@@ -326,7 +326,7 @@ let with_session sr f =
 let exec_xmlrpc ~dbg ?context:_ ?(needs_session = true) (driver : string)
     (call : call) =
   with_dbg ~name:call.cmd ~dbg @@ fun di ->
-  let _ = Debuginfo.to_string di in
+  let dbg = Debuginfo.to_string di in
   let do_call call =
     let xml = xmlrpc_of_call call in
     let name = Printf.sprintf "sm_exec: %s" call.cmd in
@@ -337,7 +337,19 @@ let exec_xmlrpc ~dbg ?context:_ ?(needs_session = true) (driver : string)
           try
             E.debug "smapiv2=>smapiv1 [label=\"%s\"];" call.cmd ;
             let output, stderr =
-              Forkhelpers.execute_command_get_output exe [Xml.to_string xml]
+              let env =
+                match Xapi_observer_components.is_smapi_enabled () with
+                | false ->
+                    None
+                | true ->
+                    let traceparent = Debuginfo.traceparent_of_dbg dbg in
+                    Some
+                      (Xapi_observer_components.env_vars_of_component
+                         ~component:Xapi_observer_components.SMApi ~traceparent
+                      )
+              in
+              Forkhelpers.execute_command_get_output ?env exe
+                [Xml.to_string xml]
             in
             try (Xml.parse_string output, stderr)
             with e ->

ocaml/xapi/xapi_cluster_host.ml

@@ -197,7 +197,7 @@ let resync_host ~__context ~host =
           (* create the watcher here so that the watcher exists after toolstack restart *)
           create_cluster_watcher_on_master ~__context ~host ;
           Xapi_observer.initialise_observer ~__context
-            Xapi_observer.Component.Xapi_clusterd ;
+            Xapi_observer_components.Xapi_clusterd ;
           let verify = Stunnel_client.get_verify_by_default () in
           set_tls_config ~__context ~self ~verify
       )
@@ -307,7 +307,7 @@ let enable ~__context ~self =
       ) ;
       create_cluster_watcher_on_master ~__context ~host ;
       Xapi_observer.initialise_observer ~__context
-        Xapi_observer.Component.Xapi_clusterd ;
+        Xapi_observer_components.Xapi_clusterd ;
       let verify = Stunnel_client.get_verify_by_default () in
       set_tls_config ~__context ~self ~verify ;
       let init_config =

ocaml/xapi/xapi_globs.ml

@@ -938,6 +938,8 @@ let repository_gpgkey_name = ref ""
 
 let repository_gpgcheck = ref true
 
+let observer_config_dir = "/etc/xensource/observer"
+
 let ignore_vtpm_unimplemented = ref false
 
 let evacuation_batch_size = ref 10