From 73f5a30296b702dae579c66d4296bcdc39f31f02 Mon Sep 17 00:00:00 2001 From: Colin James Date: Thu, 4 Jul 2024 15:27:13 +0100 Subject: [PATCH] IH-642 Restructure xs-trace to use Cmdliner The xs-trace utility is restructured to enhance its readability and, to aid with potential future extension, its CLI is reimplemented in terms of Cmdliner. It is hoped that the current command modes are consistent with what was already expected by xs-trace, i.e. xs-trace (cp|mv) These changes should make it simpler to extend this utility with more functionality. For example, there is an idea to add some short conversion routines from Zipkinv2 to Google's Catapult trace format - so that single host triaging can bypass heavy distributed tracing services and use functionality built into Chrome (or the online Perfetto trace viewer). Signed-off-by: Colin James --- ocaml/xs-trace/dune | 13 ++++ ocaml/xs-trace/xs_trace.ml | 126 +++++++++++++++++++++++++------------ 2 files changed, 98 insertions(+), 41 deletions(-) diff --git a/ocaml/xs-trace/dune b/ocaml/xs-trace/dune index b168c190faa..05e485a2c0a 100644 --- a/ocaml/xs-trace/dune +++ b/ocaml/xs-trace/dune @@ -4,7 +4,20 @@ (public_name xs-trace) (package xapi) (libraries + cmdliner tracing_export xapi-stdext-unix ) ) + +(rule + (targets xs-trace.1) + (deps (:exe xs_trace.exe)) + (action (with-stdout-to %{targets} (run %{exe} --help=groff))) +) + +(install + (section man) + (package xapi) + (files (xs-trace.1 as man1/xs-trace.1)) +) diff --git a/ocaml/xs-trace/xs_trace.ml b/ocaml/xs-trace/xs_trace.ml index 9d481e0e7a4..e51847c9256 100644 --- a/ocaml/xs-trace/xs_trace.ml +++ b/ocaml/xs-trace/xs_trace.ml @@ -12,48 +12,92 @@ * GNU Lesser General Public License for more details. *) -let _ = - match Sys.argv with - | [|_; action; origin; url_string|] -> - let url = Uri.of_string url_string in - let submit_json json = - if json <> "" then - let result = Tracing_export.Destination.Http.export ~url json in - match result with - | Ok _ -> - () - | Error err -> - Printf.eprintf "Error: %s" (Printexc.to_string err) ; - exit 1 - in - let rec export_file orig = - if Sys.is_directory orig then - let files = Sys.readdir orig in - let file_paths = Array.map (Filename.concat orig) files in - Array.iter export_file file_paths - else if Filename.check_suffix orig ".zst" then - Xapi_stdext_unix.Unixext.with_file orig [O_RDONLY] 0o000 - @@ fun compressed_file -> - Zstd.Fast.decompress_passive compressed_file @@ fun decompressed -> - if Filename.check_suffix orig ".ndjson.zst" then +module Exporter = struct + module Unixext = Xapi_stdext_unix.Unixext + + (* Submit JSON to a specified endpoint. *) + let submit_json url json = + if json <> "" then + match Tracing_export.Destination.Http.export ~url json with + | Error err -> + Printf.eprintf "Error: %s" (Printexc.to_string err) ; + exit 1 + | _ -> + () + + (** Export traces from file system to a remote endpoint. *) + let export erase src dst = + let dst = Uri.of_string dst in + let submit_json = submit_json dst in + let rec export_file = function + | path when Sys.is_directory path -> + (* Recursively export trace files. *) + Sys.readdir path + |> Array.iter (fun f -> Filename.concat path f |> export_file) + | path when Filename.check_suffix path ".zst" -> + (* Decompress compressed trace file and decide whether to + treat it as line-delimited or not. *) + let ( let@ ) = ( @@ ) in + let@ compressed = Unixext.with_file path [O_RDONLY] 0o000 in + let@ decompressed = Zstd.Fast.decompress_passive compressed in + if Filename.check_suffix path ".ndjson.zst" then let ic = Unix.in_channel_of_descr decompressed in - Xapi_stdext_unix.Unixext.lines_iter - (fun line -> submit_json line) - ic + Unixext.lines_iter submit_json ic else - let json = Xapi_stdext_unix.Unixext.string_of_fd decompressed in + let json = Unixext.string_of_fd decompressed in submit_json json - else if Filename.check_suffix orig ".ndjson" then - Xapi_stdext_unix.Unixext.readfile_line - (fun line -> submit_json line) - orig - else - let json = Xapi_stdext_unix.Unixext.string_of_file orig in + | path when Filename.check_suffix path ".ndjson" -> + (* Submit traces line by line. *) + Unixext.readfile_line submit_json path + | path -> + (* Assume any other extension is a valid JSON file. *) + let json = Unixext.string_of_file path in submit_json json - in - export_file origin ; - if action = "mv" then - Xapi_stdext_unix.Unixext.rm_rec ~rm_top:true origin - | _ -> - Printf.eprintf "Usage: %s cp/mv \n" Sys.argv.(0) ; - exit 1 + in + export_file src ; + if erase then + Unixext.rm_rec ~rm_top:true src +end + +module Cli = struct + open Cmdliner + + let src = + let doc = "The trace file, e.g. /path/to/trace.ndjson" in + Arg.(required & pos 0 (some string) None (info [] ~docv:"SRC" ~doc)) + + let dst = + let doc = + "The destination endpoint URL, e.g. http://localhost:9411/api/v2/spans" + in + Arg.(required & pos 1 (some string) None (info [] ~docv:"DST" ~doc)) + + let export_term ~erase = Term.(const Exporter.export $ const erase $ src $ dst) + + let cp_cmd = + let term = export_term ~erase:false in + let doc = "copy a trace to an endpoint" in + Cmd.(v (info "cp" ~doc) term) + + let mv_cmd = + let term = export_term ~erase:true in + let doc = "copy a trace to an endpoint and erase it afterwards" in + Cmd.(v (info "mv" ~doc) term) + + let xs_trace_cmd = + let man = + [ + `S "DESCRIPTION" + ; `P "$(mname) is a utility for working with local trace files" + ] + in + let desc = + let doc = "utility for working with local trace files" in + Cmd.info "xs-trace" ~doc ~version:"0.1" ~man + in + Cmd.group desc [cp_cmd; mv_cmd] + + let main () = Cmd.eval xs_trace_cmd +end + +let () = exit (Cli.main ())