CP-45235: Support for xe-cli to transmit traceparent

Adds the possibility of `xe` commands to pass a `traceparent`.

This can be done through the following ways:

- a command arg: `xe <cmd> --traceparent <traceparent>`;
- a environment variable: `TRACEPARENT=<traceparent>`:
- specifying `traceparent=<traceparent>` in `.xe`.

Priority is given in the same order as above.

This should enable creating a single trace from the `xe-cli` caller
through `xapi`.

Signed-off-by: Gabriel Buica <[email protected]>

ocaml/xapi-cli-server/xapi_cli.ml

@@ -121,7 +121,7 @@ let with_session ~local rpc u p session f =
     (fun () -> f session)
     (fun () -> do_logout ())
 
-let do_rpcs _req s username password minimal cmd session args =
+let do_rpcs _req s username password minimal cmd session args tracing =
   let cmdname = get_cmdname cmd in
   let cspec =
     try Hashtbl.find cmdtable cmdname
@@ -137,7 +137,8 @@ let do_rpcs _req s username password minimal cmd session args =
   try
     let generic_rpc = get_rpc () in
     (* NB the request we've received is for the /cli. We need an XMLRPC request for the API *)
-    Tracing.with_tracing ~name:("xe " ^ cmdname) @@ fun tracing ->
+    Tracing.with_tracing ~parent:tracing ~name:("xe " ^ cmdname)
+    @@ fun tracing ->
     let req = Xmlrpc_client.xmlrpc ~version:"1.1" ~tracing "/" in
     let rpc = generic_rpc req s in
     if do_forward then
@@ -188,6 +189,14 @@ let uninteresting_cmd_postfixes = ["help"; "-get"; "-list"]
 
 let exec_command req cmd s session args =
   let params = get_params cmd in
+  let tracing =
+    Option.bind
+      Http.Request.(req.traceparent)
+      Tracing.SpanContext.of_traceparent
+    |> Option.map (fun span_context ->
+           Tracing.Tracer.span_of_span_context span_context (get_cmdname cmd)
+       )
+  in
   let minimal =
     if List.mem_assoc "minimal" params then
       bool_of_string (List.assoc "minimal" params)
@@ -248,7 +257,7 @@ let exec_command req cmd s session args =
             params
          )
       ) ;
-    do_rpcs req s u p minimal cmd session args
+    do_rpcs req s u p minimal cmd session args tracing
 
 let get_line str i =
   try

ocaml/xe-cli/newcli.ml

@@ -31,6 +31,8 @@ let xapipasswordfile = ref ""
 
 let xapiport = ref None
 
+let traceparent = ref None
+
 let get_xapiport ssl =
   match !xapiport with None -> if ssl then 443 else 80 | Some p -> p
 
@@ -66,7 +68,7 @@ exception Usage
 let usage () =
   error
     "Usage: %s <cmd> [-s server] [-p port] ([-u username] [-pw password] or \
-     [-pwf <password file>]) <other arguments>\n"
+     [-pwf <password file>]) [--traceparent traceparent] <other arguments>\n"
     Sys.argv.(0) ;
   error
     "\n\
@@ -208,6 +210,8 @@ let parse_args =
       | "debugonfail" -> (
           xedebugonfail := try bool_of_string v with _ -> false
         )
+      | "traceparent" ->
+          traceparent := Some v
       | _ ->
           raise Not_found
       ) ;
@@ -234,6 +238,8 @@ let parse_args =
         Some ("debugonfail", "true", xs)
     | "-h" :: h :: xs ->
         Some ("server", h, xs)
+    | "--traceparent" :: h :: xs ->
+        Some ("traceparent", h, xs)
     | _ ->
         None
   in
@@ -286,6 +292,10 @@ let parse_args =
       List.rev !l
     in
     let extras_rest = process_args extras in
+    (*if traceparent is set as env var update it after we process the extras.*)
+    Option.iter
+      (fun tp -> traceparent := Some tp)
+      (Sys.getenv_opt Tracing.EnvHelpers.traceparent_key) ;
     let help = ref false in
     let args' = List.filter (fun s -> s <> "-help" && s <> "--help") args in
     if List.length args' < List.length args then help := true ;
@@ -300,7 +310,7 @@ let parse_args =
         debug_channel := Some tmpch
       )
     in
-    args_rest @ extras_rest @ rcs_rest @ !reserve_args
+    (args_rest @ extras_rest @ rcs_rest @ !reserve_args, !traceparent)
 
 let exit_status = ref 1
 
@@ -790,7 +800,7 @@ let main () =
         Printf.printf "ThinCLI protocol: %d.%d\n" major minor ;
         exit 0
       ) ;
-      let args = parse_args args in
+      let args, traceparent = parse_args args in
       (* All the named args are taken as permitted filename to be uploaded *)
       let permitted_filenames = get_permit_filenames args in
       if List.length args < 1 then
@@ -803,6 +813,7 @@ let main () =
         in
         let args = String.concat "\n" args in
         Printf.fprintf oc "User-agent: xe-cli/Unix/%d.%d\r\n" major minor ;
+        Option.iter (Printf.fprintf oc "traceparent: %s\r\n") traceparent ;
         Printf.fprintf oc "content-length: %d\r\n\r\n" (String.length args) ;
         Printf.fprintf oc "%s" args ;
         flush_all () ;