rm util.ml + clean up

src/log_reporter.ml

@@ -0,0 +1,60 @@
+let detail_tag : string Logs.Tag.def =
+  Logs.Tag.def "Detail tag" ~doc:"" Fmt.string
+
+let detail s = Logs.Tag.(empty |> add detail_tag s)
+let time_anchor = Mirage_ptime.now () |> Ptime.to_span
+
+let color_of_log_level = function
+  | Logs.App -> `White
+  | Error -> `Red
+  | Warning -> `Yellow
+  | Info -> `Blue
+  | Debug -> `Magenta
+
+let reporter : Logs.reporter =
+  let open Fmt in
+  let pp_timestamp = styled `Faint (styled (`Fg `White) (fmt "%09.04f")) in
+  let pp_header ppf v =
+    let color = color_of_log_level (fst v) in
+    let pp = styled (`Fg color) Logs.pp_header in
+    pf ppf "%a" pp v
+  in
+  let pp_src_name =
+    let pp = using Logs.Src.name (styled `Cyan (fmt "%s: ")) in
+    fun ppf v -> if not @@ Logs.Src.equal Logs.default v then pp ppf v
+  in
+  let pp_detail = option (styled `Green (fmt " (%s)")) in
+  let report src lvl ~over k msgf =
+    let ppf =
+      match lvl with
+      | Logs.App -> stdout
+      | Error | Warning | Info | Debug -> stderr
+    in
+    let k _ppf = over (); k () in
+    let with_detail h tags k user_fmt =
+      let detail = Option.bind tags (Logs.Tag.find detail_tag) in
+      let timestamp =
+        Ptime.sub_span (Mirage_ptime.now ()) time_anchor
+        |> Option.map Ptime.to_float_s
+        |> Option.value ~default:0.
+      in
+      let k ppf = kpf k ppf "%a@." pp_detail detail in
+      let k ppf = kpf k ppf user_fmt in
+      kpf k ppf "%a %a %a" pp_timestamp timestamp pp_header (lvl, h) pp_src_name
+        src
+    in
+    msgf @@ fun ?header ?tags fmt -> with_detail header tags k fmt
+  in
+  { report }
+
+let set_level_secmods lvl =
+  let secmod_srcs = [ Secmod_rsa.src; Secmod_eddsa.src ] in
+  List.iter (fun src -> Logs.Src.set_level src lvl) secmod_srcs;
+  ()
+
+let setup level =
+  (*     set_level_secmods level; *)
+  Logs.set_level ~all:false level;
+  Logs.Src.set_level Logs.default level;
+  Logs.set_reporter reporter;
+  ()