From d605351f555462bc2d29640008b434b4ffc50da5 Mon Sep 17 00:00:00 2001 From: xenia Date: Tue, 23 Apr 2024 01:39:03 -0400 Subject: [PATCH] bikeshed source location and exceptions --- README.md | 26 +++++++++++++++++++++ lib/core.ml | 11 ++++++--- lib/journald.ml | 21 +++++++++++++++-- lib/pretty.ml | 54 ++++++++++++++++++++++++++++++++++++-------- lib/util.ml | 10 +++++++++ lib/xlog.ml | 60 +++++++++++++++++++++++++++++++++++-------------- lib/xlog.mli | 21 ++++++++++++----- 7 files changed, 166 insertions(+), 37 deletions(-) diff --git a/README.md b/README.md index 544b8e0..059b9bd 100644 --- a/README.md +++ b/README.md @@ -11,12 +11,38 @@ same license ```ocaml include (val Xlog.logs __FUNCTION__) +(* basic usage *) let () = info (fun m -> m "meow meow meow") +(* add source location info *) +let () = + info ~__POS__ ~__FUNCTION__ (fun m -> m "meow meow meow") + +(* log exception *) +try + fallible_task () +with +| e -> + exn e (Printexc.get_raw_backtrace ()) ~__POS__ ~__FUNCTION__ + (fun m -> m "encountered error") + module Submodule = struct include (val Xlog.logs __FUNCTION__) (* ... *) end + +(* in the main module *) +Xlog.init_pretty_writer stdout + ~min_level:Xlog.DEBUG + (* other options *) + +(* if running as a daemon *) +if Xlog.should_upgrade_to_journald () then + Xlog.init_journald_writer () + ~min_level:Xlog.DEBUG +else + Xlog.init_pretty_writer stdout + ~min_level:Xlog.DEBUG ``` diff --git a/lib/core.ml b/lib/core.ml index 8f6482f..c8787e5 100644 --- a/lib/core.ml +++ b/lib/core.ml @@ -10,10 +10,15 @@ external int_of_level : level -> int = "%identity" type writer = ts:Time.t -> ns:string -> + filename:string -> + lineno:int -> + func:string -> + errno:int -> + exn:((exn * Printexc.raw_backtrace) option) -> lvl:level -> string -> unit -let ( +++ ) w1 w2 ~ts ~ns ~lvl msg = - w1 ~ts ~ns ~lvl msg; - w2 ~ts ~ns ~lvl msg +let ( +++ ) w1 w2 ~ts ~ns ~filename ~lineno ~func ~errno ~exn ~lvl msg = + w1 ~ts ~ns ~filename ~lineno ~func ~errno ~exn ~lvl msg; + w2 ~ts ~ns ~filename ~lineno ~func ~errno ~exn ~lvl msg diff --git a/lib/journald.ml b/lib/journald.ml index 574d679..1525afb 100644 --- a/lib/journald.ml +++ b/lib/journald.ml @@ -40,13 +40,30 @@ let syslog_priority = function | WARN -> "4" (* LOG_WARNING *) | ERROR -> "3" (* LOG_ERR *) -let writer t ~ts ~ns ~lvl msg = +let writer t ~ts ~ns ~filename ~lineno ~func ~errno ~exn ~lvl msg = Mutex.lock t.mutex; let dgram = Buffer.clear t.buf; ignore ts; - add_field t.buf "MESSAGE" (Printf.sprintf "%s: %s" ns msg); + let maybe_exn = match exn with + | Some (exn, bt) -> + Printf.sprintf "\nException: %s\n%s" (Printexc.to_string exn) + (Printexc.raw_backtrace_to_string bt) + | None -> "" + in + add_field t.buf "MESSAGE" (Printf.sprintf "%s: %s%s" ns msg maybe_exn); add_field t.buf "PRIORITY" (syslog_priority lvl); + begin if not (filename = "") then + add_field t.buf "CODE_FILE" filename; + add_field t.buf "CODE_LINE" (Printf.sprintf "%d" lineno) + end; + begin if not (func = "") then + add_field t.buf "CODE_FUNC" func + end; + let errno = Util.get_errno errno exn in + begin if errno != 0 then + add_field t.buf "ERRNO" (Printf.sprintf "%d" errno) + end; Buffer.to_bytes t.buf in Mutex.unlock t.mutex; diff --git a/lib/pretty.ml b/lib/pretty.ml index c8adbb7..9e857d2 100644 --- a/lib/pretty.ml +++ b/lib/pretty.ml @@ -13,12 +13,16 @@ type config = { timestamp : bool; namespace : bool; level : bool; + source_loc : bool; + backtrace : bool; } -let _fl_c = 1 (* color *) -let _fl_t = 2 (* timestamp *) -let _fl_n = 4 (* namespace *) -let _fl_l = 8 (* level *) +let _fl_c = 1 (* color *) +let _fl_t = 2 (* timestamp *) +let _fl_n = 4 (* namespace *) +let _fl_l = 8 (* level *) +let _fl_s = 16 (* source_loc *) +let _fl_b = 32 (* backtrace *) let _fl_ct = _fl_c + _fl_t let _fl_cl = _fl_c + _fl_l @@ -40,6 +44,10 @@ let ansi_dim = "\x1b[2m" let ansi_bold = "\x1b[1m" let ansi_off = "\x1b[0m" +let box_at = "└─ " +let box_exn = "├─ " +let box_bt = "├─── " + let pr_timestamp bp ts = Buffer.add_string bp (Time.to_string ts) @@ -65,10 +73,12 @@ let make (out : out_channel) (cfg : config) = { bp = Buffer.create 512; align_to = 0; out; - flags = (if cfg.color then _fl_c else 0) + - (if cfg.timestamp then _fl_t else 0) + - (if cfg.namespace then _fl_n else 0) + - (if cfg.level then _fl_l else 0) + flags = (if cfg.color then _fl_c else 0) + + (if cfg.timestamp then _fl_t else 0) + + (if cfg.namespace then _fl_n else 0) + + (if cfg.level then _fl_l else 0) + + (if cfg.source_loc then _fl_s else 0) + + (if cfg.backtrace then _fl_b else 0) } let pr_msg bp msg ts ns lvl ~align ~indent ~f = @@ -91,7 +101,8 @@ let pr_msg bp msg ts ns lvl ~align ~indent ~f = Buffer.add_string bp "\n"; end -let writer t ~ts ~ns ~lvl msg = +let writer t ~ts ~ns ~filename ~lineno ~func ~errno ~exn ~lvl msg = + ignore errno; let f mask = t.flags land mask = mask in let align bp = let n = t.align_to - Buffer.length bp in @@ -107,6 +118,31 @@ let writer t ~ts ~ns ~lvl msg = begin Mutex.lock t.mutex; pr_msg t.bp msg ts ns lvl ~align ~indent ~f; + begin match exn with + | Some (exn, bt) -> + Buffer.add_string t.bp box_exn; + Printf.bprintf t.bp "Exception: %s\n" (Printexc.to_string exn); + (* if not called within an exception handler, or backtraces are disabled, we don't get a + backtrace and thus empty string will get added *) + if f _fl_b then begin + let bt_parts = String.split_on_char '\n' (Printexc.raw_backtrace_to_string bt) in + List.iter (fun line -> + if not (String.trim line = "") then begin + Buffer.add_string t.bp box_bt; + Buffer.add_string t.bp line; + Buffer.add_string t.bp "\n" end) bt_parts + end + | None -> () + end; + if f _fl_s && (not (filename = "") || not (func = "")) then begin + Buffer.add_string t.bp box_at; + begin match (filename, func) with + | ("", _) -> Printf.bprintf t.bp "%s" func + | (_, "") -> Printf.bprintf t.bp "%s:%d" filename lineno + | _ -> Printf.bprintf t.bp "%s @ %s:%d" func filename lineno + end; + Buffer.add_string t.bp "\n" + end; Buffer.output_buffer t.out t.bp; flush t.out; Buffer.clear t.bp; diff --git a/lib/util.ml b/lib/util.ml index 5eec823..cdc02c2 100644 --- a/lib/util.ml +++ b/lib/util.ml @@ -7,3 +7,13 @@ let parse_module_name (name : string) : string list = | fst::rst -> let fst = Str.global_replace dune_exe_rx "[EXE]" fst in (Str.split dune_underscore_rx fst) @ rst + +external unix_code_of_unix_error : Unix.error -> int = "caml_unix_code_of_unix_error" + +let get_errno errno exn = + if errno != 0 then + errno + else + match exn with + | Some ((Unix.Unix_error (err, _, _)), _) -> unix_code_of_unix_error err + | _ -> 0 diff --git a/lib/xlog.ml b/lib/xlog.ml index 48b3a5e..cdaa53c 100644 --- a/lib/xlog.ml +++ b/lib/xlog.ml @@ -52,37 +52,61 @@ let rec find_or_make_logger parent_logger ns = type 'a log_function = ((('a, Format.formatter, unit) format -> 'a) -> unit) -> unit -let write logger lvl msg = +type 'a log_module_function = + ?__POS__:(string * int * int * int) + -> ?__FUNCTION__:string + -> ?errno:int + -> ('a log_function) + +let write logger filename lineno func errno exn lvl msg = let ts = Time.stamp () in let ns = logger.namespace in - Option.iter (fun w -> w ~ts ~ns ~lvl msg) logger.writers + Option.iter (fun w -> w ~ts ~ns ~filename ~lineno ~func ~errno ~exn ~lvl msg) logger.writers -let[@inline] logf logger lvl : _ log_function = fun logk -> +let[@inline] logf logger lvl ~__POS__ ~__FUNCTION__ ~errno ~exn : _ log_function = fun logk -> if int_of_level lvl >= logger.min_level then logk (fun fmt -> - Format.kasprintf (write logger lvl) + let (filename, lineno, _, _) = __POS__ in + let func = Util.parse_module_name __FUNCTION__ |> String.concat "." in + Format.kasprintf (write logger filename lineno func errno exn lvl) ("@[" ^^ fmt)) module type Logs = sig val logger : logger - val trace : _ log_function - val debug : _ log_function - val info : _ log_function - val warn : _ log_function - val error : _ log_function - val log : level -> _ log_function + val trace : _ log_module_function + val debug : _ log_module_function + val info : _ log_module_function + val warn : _ log_module_function + val error : _ log_module_function + val exn : exn -> Printexc.raw_backtrace -> _ log_module_function + val log : level -> ?exn:((exn * Printexc.raw_backtrace) option) -> _ log_module_function end let make_logs parent_logger ns = (module struct let logger = find_or_make_logger parent_logger ns - let[@inline] trace k = logf logger TRACE k - let[@inline] debug k = logf logger DEBUG k - let[@inline] info k = logf logger INFO k - let[@inline] warn k = logf logger WARN k - let[@inline] error k = logf logger ERROR k - let[@inline] log level k = logf logger level k + let[@inline] trace + ?(__POS__=("",0,0,0)) ?(__FUNCTION__="") ?(errno=0) + k = logf logger TRACE ~__POS__ ~__FUNCTION__ ~errno ~exn:None k + let[@inline] debug + ?(__POS__=("",0,0,0)) ?(__FUNCTION__="") ?(errno=0) + k = logf logger DEBUG ~__POS__ ~__FUNCTION__ ~errno ~exn:None k + let[@inline] info + ?(__POS__=("",0,0,0)) ?(__FUNCTION__="") ?(errno=0) + k = logf logger INFO ~__POS__ ~__FUNCTION__ ~errno ~exn:None k + let[@inline] warn + ?(__POS__=("",0,0,0)) ?(__FUNCTION__="") ?(errno=0) + k = logf logger WARN ~__POS__ ~__FUNCTION__ ~errno ~exn:None k + let[@inline] error + ?(__POS__=("",0,0,0)) ?(__FUNCTION__="") ?(errno=0) + k = logf logger ERROR ~__POS__ ~__FUNCTION__ ~errno ~exn:None k + let[@inline] exn exn bt + ?(__POS__=("",0,0,0)) ?(__FUNCTION__="") ?(errno=0) + k = logf logger ERROR ~__POS__ ~__FUNCTION__ ~errno ~exn:(Some (exn, bt)) k + let[@inline] log level ?(exn=None) + ?(__POS__=("",0,0,0)) ?(__FUNCTION__="") ?(errno=0) + k = logf logger level ~__POS__ ~__FUNCTION__ ~errno ~exn k end : Logs) let logs ns = make_logs root_logger (Util.parse_module_name ns) @@ -111,9 +135,11 @@ let init_pretty_writer ?(timestamp = true) ?(namespace = true) ?(level = true) + ?(source_loc = true) + ?(backtrace = true) out = - Pretty.make out { color; timestamp; namespace; level } |> + Pretty.make out { color; timestamp; namespace; level; source_loc; backtrace } |> Pretty.writer |> add_writer ?min_level diff --git a/lib/xlog.mli b/lib/xlog.mli index 4993eed..5eed14e 100644 --- a/lib/xlog.mli +++ b/lib/xlog.mli @@ -11,14 +11,21 @@ type level = type 'a log_function = ((('a, Format.formatter, unit) format -> 'a) -> unit) -> unit +type 'a log_module_function = + ?__POS__:(string * int * int * int) + -> ?__FUNCTION__:string + -> ?errno:int + -> ('a log_function) + module type Logs = sig val logger : logger - val trace : _ log_function - val debug : _ log_function - val info : _ log_function - val warn : _ log_function - val error : _ log_function - val log : level -> _ log_function + val trace : _ log_module_function + val debug : _ log_module_function + val info : _ log_module_function + val warn : _ log_module_function + val error : _ log_module_function + val exn : exn -> Printexc.raw_backtrace -> _ log_module_function + val log : level -> ?exn:((exn * Printexc.raw_backtrace) option) -> _ log_module_function end val logs : string -> (module Logs) @@ -30,6 +37,8 @@ val init_pretty_writer : ?timestamp:bool -> ?namespace:bool -> ?level:bool -> + ?source_loc:bool -> + ?backtrace:bool -> out_channel -> unit val init_journald_writer :