From 036f455a1c74b1810f5ead4e2f11fe0c09f57827 Mon Sep 17 00:00:00 2001 From: swrup Date: Sun, 30 Nov 2025 03:21:14 +0100 Subject: [PATCH] --- src/mte.ml | 59 +++-------------------------------------------------- src/util.ml | 56 ++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 59 insertions(+), 56 deletions(-) diff --git a/src/mte.ml b/src/mte.ml index fc7b7e48..a0dd9613 100644 --- a/src/mte.ml +++ b/src/mte.ml @@ -13,60 +13,6 @@ You should have received a copy of the GNU Affero General Public License along with this program. If not, see . *) -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 = Ptime_clock.now () |> Ptime.to_span - -let log_level_color = 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 "%04.02f")) in - let pp_header ppf v = - let color = fst v |> log_level_color 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 = 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 (Ptime_clock.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 () = - Fmt_tty.setup_std_outputs ~style_renderer:`Ansi_tty ~utf_8:true (); - Logs.set_reporter reporter; - Logs.set_level ~all:false (Some Logs.Debug); - Logs.Src.set_level Logs.default (Some Logs.Debug); - Logs_threaded.enable (); - Printexc.record_backtrace true; - () - let error_detail ?hint _status = let open Api in let code = -1 in @@ -170,7 +116,7 @@ let routes = ] let () = - (*Logs.set_reporter (Logs_fmt.reporter ());*) + Util.Log_reporter.setup (); let cfg = let port = Config.Exchange.port in let sockaddr = Unix.(ADDR_INET (inet_addr_loopback, port)) in @@ -186,5 +132,6 @@ let () = [ Devices.db_connection; Devices.secmod_signkey; Devices.secmod_denom ] in let middlewares = Vif.Middlewares.[] in - Logs.info (fun m -> m ~tags:(detail "~~!") "Starting MTE server"); + Logs.info (fun m -> + m ~tags:(Util.Log_reporter.detail "~~!") "Starting MTE server"); Vif.run ~cfg ~devices ~middlewares routes env diff --git a/src/util.ml b/src/util.ml index 8d5d1f8b..785958c9 100644 --- a/src/util.ml +++ b/src/util.ml @@ -114,3 +114,59 @@ module Bin_rsa = struct | Error (`Msg e) -> Fmt.failwith "rsa priv_of_octets failure: %s@." e | Ok v -> v end + +module Log_reporter = struct + 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 = Ptime_clock.now () |> Ptime.to_span + + let log_level_color = 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 "%04.02f")) in + let pp_header ppf v = + let color = fst v |> log_level_color 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 = 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 (Ptime_clock.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 setup () = + Fmt_tty.setup_std_outputs ~style_renderer:`Ansi_tty ~utf_8:true (); + Logs.set_reporter reporter; + Logs.set_level ~all:false (Some Logs.Debug); + Logs.Src.set_level Logs.default (Some Logs.Debug); + Logs_threaded.enable (); + Printexc.record_backtrace true; + () +end