diff --git a/ocaml/xapi-cli-server/xapi_cli.ml b/ocaml/xapi-cli-server/xapi_cli.ml index 64161f22442..89a9a0177b4 100644 --- a/ocaml/xapi-cli-server/xapi_cli.ml +++ b/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 diff --git a/ocaml/xe-cli/newcli.ml b/ocaml/xe-cli/newcli.ml index fcb5c4272f8..6d8a55590d4 100644 --- a/ocaml/xe-cli/newcli.ml +++ b/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 [-s server] [-p port] ([-u username] [-pw password] or \ - [-pwf ]) \n" + [-pwf ]) [--traceparent traceparent] \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 () ;