Logging: refactoring/code deduplication

src/bin_node/node_config_file.ml

@@ -37,7 +37,7 @@ type t = {
   data_dir : string ;
   p2p : p2p ;
   rpc : rpc ;
-  log : log ;
+  log : Logging_unix.cfg ;
   shell : shell ;
 }
 
@@ -62,13 +62,6 @@ and tls = {
   key : string ;
 }
 
-and log = {
-  output : Logging_unix.Output.t ;
-  default_level : Logging.level ;
-  rules : string option ;
-  template : Logging.template ;
-}
-
 and shell = {
   block_validator_limits : Node.block_validator_limits ;
   prevalidator_limits : Node.prevalidator_limits ;
@@ -117,13 +110,6 @@ let default_rpc = {
   tls = None ;
 }
 
-let default_log = {
-  output = Stderr ;
-  default_level = Notice ;
-  rules = None ;
-  template = Logging.default_template ;
-}
-
 let default_shell = {
   block_validator_limits = Node.default_block_validator_limits ;
   prevalidator_limits = Node.default_prevalidator_limits ;
@@ -135,7 +121,7 @@ let default_config = {
   data_dir = default_data_dir ;
   p2p = default_p2p ;
   rpc = default_rpc ;
-  log = default_log ;
+  log = Logging_unix.default_cfg ;
   shell = default_shell ;
 }
 
@@ -336,58 +322,6 @@ let rpc : rpc Data_encoding.t =
           string)
     )
 
-let level_encoding =
-  let open Logging in
-  let open Data_encoding in
-  conv
-    (function
-      | Fatal -> "fatal"
-      | Error -> "error"
-      | Warning -> "warning"
-      | Notice -> "notice"
-      | Info -> "info"
-      | Debug -> "debug")
-    (function
-      | "error" -> Error
-      | "warn" -> Warning
-      | "notice" -> Notice
-      | "info" -> Info
-      | "debug" -> Debug
-      | "fatal" -> Fatal
-      | _ -> invalid_arg "Logging.level")
-    string
-
-let log =
-  let open Data_encoding in
-  conv
-    (fun {output ; default_level ; rules ; template } ->
-       (output, default_level, rules, template))
-    (fun (output, default_level, rules, template) ->
-       { output ; default_level ; rules ; template })
-    (obj4
-       (dft "output"
-          ~description: "Output for the logging function. Either 'stdout', \
-                         'stderr' or the name of a log file ."
-          Logging_unix.Output.encoding default_log.output)
-       (dft "level"
-          ~description: "Verbosity level: one of 'fatal', 'error', 'warn',\
-                         'notice', 'info', 'debug'."
-          level_encoding default_log.default_level)
-       (opt "rules"
-          ~description: "Fine-grained logging instructions. Same format as \
-                         described in `tezos-node run --help`, DEBUG section. \
-                         In the example below, sections 'p2p' and all sections \
-                         starting by 'client' will have their messages logged \
-                         up to the debug level, whereas the rest of log sections \
-                         will be logged up to the notice level."
-          string)
-       (dft "template"
-          ~description: "Format for the log file, see \
-                         http://ocsigen.org/lwt/dev/api/Lwt_log_core#2_Logtemplates."
-          string default_log.template)
-    )
-
-
 let worker_limits_encoding
     default_size
     default_level
@@ -401,7 +335,7 @@ let worker_limits_encoding
        { backlog_size ; backlog_level ; zombie_lifetime ; zombie_memory })
     (obj4
        (dft "worker_backlog_size" uint16 default_size)
-       (dft "worker_backlog_level" level_encoding default_level)
+       (dft "worker_backlog_level" Logging_unix.level_encoding default_level)
        (dft "worker_zombie_lifetime" float default_zombie_lifetime)
        (dft "worker_zombie_memory" float default_zombie_memory))
 
@@ -525,7 +459,7 @@ let encoding =
           ~description: "Configuration of network parameters" p2p)
        (dft "log"
           ~description: "Configuration of network parameters"
-          log default_log)
+          Logging_unix.cfg_encoding Logging_unix.default_cfg)
        (dft "shell"
           ~description: "Configuration of network parameters"
           shell default_shell))
@@ -624,7 +558,7 @@ let update
     tls =
       Option.first_some rpc_tls cfg.rpc.tls ;
   }
-  and log : log = {
+  and log : Logging_unix.cfg = {
     cfg.log with
     output = Option.unopt ~default:cfg.log.output log_output ;
   }

src/bin_node/node_config_file.mli

@@ -27,7 +27,7 @@ type t = {
   data_dir : string ;
   p2p : p2p ;
   rpc : rpc ;
-  log : log ;
+  log : Logging_unix.cfg ;
   shell : shell ;
 }
 
@@ -52,13 +52,6 @@ and tls = {
   key : string ;
 }
 
-and log = {
-  output : Logging_unix.Output.t ;
-  default_level : Logging.level ;
-  rules : string option ;
-  template : Logging.template ;
-}
-
 and shell = {
   block_validator_limits : Node.block_validator_limits ;
   prevalidator_limits : Node.prevalidator_limits ;

src/bin_node/node_run_command.ml

@@ -89,23 +89,6 @@ let find_log_rules default =
             defined, using TEZOS_LOG." ;
       "environment varible TEZOS_LOG", Some rules
 
-let init_logger ?verbosity (log_config : Node_config_file.log) =
-  begin
-    match verbosity with
-    | Some level ->
-        Lwt_log_core.add_rule "*" level
-    | None ->
-        Lwt_log_core.add_rule "*" log_config.default_level ;
-        let origin, rules = find_log_rules log_config.rules in
-        Option.iter rules ~f:begin fun rules ->
-          try Lwt_log_core.load_rules rules ~fail_on_error:true
-          with _ ->
-            fatal_error "Incorrect log rules defined in %s, exiting." origin ;
-            exit 1
-        end
-  end ;
-  Logging_unix.init ~template:log_config.template log_config.output
-
 let init_node ?sandbox ?checkpoint (config : Node_config_file.t) =
   let patch_context json ctxt =
     begin
@@ -267,7 +250,11 @@ let run ?verbosity ?sandbox ?checkpoint (config : Node_config_file.t) =
   Lwt_lock_file.create
     ~unlink_on_exit:true (lock_file config.data_dir) >>=? fun () ->
   init_signal () ;
-  init_logger ?verbosity config.log >>= fun () ->
+  let log_cfg =
+    match verbosity with
+    | None -> config.log
+    | Some default_level -> { config.log with default_level } in
+  Logging_unix.init ~cfg:log_cfg () >>= fun () ->
   Updater.init (protocol_dir config.data_dir) ;
   lwt_log_notice "Starting the Tezos node..." >>= fun () ->
   init_node ?sandbox ?checkpoint config >>=? fun node ->

src/lib_client_base_unix/client_main_run.ml

@@ -41,34 +41,6 @@ let builtin_commands =
          return_unit) ;
   ]
 
-(* Duplicated from the node, here for now since the client still
-   embeds the baker. To be moved where appropriate when the baker is
-   definitively moved/factorized in its own binary. *)
-let find_log_rules () =
-  match Option.try_with (fun () -> Sys.getenv "TEZOS_LOG"),
-        Option.try_with (fun () -> Sys.getenv "LWT_LOG")
-  with
-  | Some rules, None -> "environment variable TEZOS_LOG", Some rules
-  | None, Some rules -> "environment variable LWT_LOG", Some rules
-  | None, None -> "default rules", None
-  | Some rules, Some _ ->
-      Format.eprintf
-        "@[<v 2>@{<warning>@{<title>Warning@}@} \
-         Both environment variables TEZOS_LOG and LWT_LOG \
-         defined, using TEZOS_LOG.@]@\n@." ;
-      "environment varible TEZOS_LOG", Some rules
-
-let init_logger () =
-  Lwt_log_core.add_rule "*" Lwt_log_core.Notice ;
-  let origin, rules = find_log_rules () in
-  Option.iter rules ~f:begin fun rules ->
-    try Lwt_log_core.load_rules rules ~fail_on_error:true
-    with _ ->
-      Pervasives.failwith
-        (Format.asprintf "Incorrect log rules defined in %s." origin)
-  end ;
-  Logging_unix.(init ~template:"$(message)" Stderr)
-
 (* Main (lwt) entry *)
 let main select_commands =
   let executable_name = Filename.basename Sys.executable_name in
@@ -89,7 +61,7 @@ let main select_commands =
                  (if Unix.isatty Unix.stdout then Ansi else Plain) Short) ;
   ignore Clic.(setup_formatter Format.err_formatter
                  (if Unix.isatty Unix.stderr then Ansi else Plain) Short) ;
-  init_logger () >>= fun () ->
+  Logging_unix.init () >>= fun () ->
   Lwt.catch begin fun () -> begin
       Client_config.parse_config_args
         (new unix_full

src/lib_p2p/test/test_p2p_io_scheduler.ml

@@ -154,7 +154,7 @@ let run
     ?max_download_speed ?max_upload_speed
     ~read_buffer_size ?read_queue_size ?write_queue_size
     addr port time n =
-  Logging_unix.init Stderr >>= fun () ->
+  Logging_unix.init () >>= fun () ->
   listen ?port addr >>= fun (main_socket, port) ->
   Process.detach ~prefix:"server: " begin fun _ ->
     server

src/lib_stdlib_unix/logging_unix.ml

@@ -113,6 +113,71 @@ module Output = struct
     Format.fprintf fmt "%s" (to_string output)
 end
 
+type cfg = {
+  output : Output.t ;
+  default_level : Logging.level ;
+  rules : string option ;
+  template : Logging.template ;
+}
+
+let create_cfg
+    ?(output = Output.Stderr)
+    ?(default_level = Logging.Notice)
+    ?rules ?(template = Logging.default_template) () =
+  { output ; default_level ; rules ; template }
+
+let default_cfg = create_cfg ()
+
+let level_encoding =
+  let open Logging in
+  let open Data_encoding in
+  conv
+    (function
+      | Fatal -> "fatal"
+      | Error -> "error"
+      | Warning -> "warning"
+      | Notice -> "notice"
+      | Info -> "info"
+      | Debug -> "debug")
+    (function
+      | "error" -> Error
+      | "warn" -> Warning
+      | "notice" -> Notice
+      | "info" -> Info
+      | "debug" -> Debug
+      | "fatal" -> Fatal
+      | _ -> invalid_arg "Logging.level")
+    string
+
+let cfg_encoding =
+  let open Data_encoding in
+  conv
+    (fun {output ; default_level ; rules ; template } ->
+       (output, default_level, rules, template))
+    (fun (output, default_level, rules, template) ->
+       { output ; default_level ; rules ; template })
+    (obj4
+       (dft "output"
+          ~description: "Output for the logging function. Either 'stdout', \
+                         'stderr' or the name of a log file ."
+          Output.encoding default_cfg.output)
+       (dft "level"
+          ~description: "Verbosity level: one of 'fatal', 'error', 'warn',\
+                         'notice', 'info', 'debug'."
+          level_encoding default_cfg.default_level)
+       (opt "rules"
+          ~description: "Fine-grained logging instructions. Same format as \
+                         described in `tezos-node run --help`, DEBUG section. \
+                         In the example below, sections 'p2p' and all sections \
+                         starting by 'client' will have their messages logged \
+                         up to the debug level, whereas the rest of log sections \
+                         will be logged up to the notice level."
+          string)
+       (dft "template"
+          ~description: "Format for the log file, see \
+                         http://ocsigen.org/lwt/dev/api/Lwt_log_core#2_Logtemplates."
+          string default_cfg.template))
+
 let init ?(template = Logging.default_template) output =
   let open Output in
   begin
@@ -135,5 +200,32 @@ let init ?(template = Logging.default_template) output =
   Lwt_log.default := logger ;
   Lwt.return_unit
 
+let find_log_rules default =
+  match Sys.(getenv_opt "TEZOS_LOG", getenv_opt "LWT_LOG") with
+  | Some rules, None -> "environment variable TEZOS_LOG", Some rules
+  | None, Some rules -> "environment variable LWT_LOG", Some rules
+  | None, None -> "configuration file", default
+  | Some rules, Some _ ->
+      Format.eprintf
+        "@[<v 2>@{<warning>@{<title>Warning@}@} \
+         Both environment variables TEZOS_LOG and LWT_LOG \
+         defined, using TEZOS_LOG.@]@\n@." ;
+      "environment varible TEZOS_LOG", Some rules
+
+let init ?(cfg = default_cfg) () =
+  Lwt_log_core.add_rule "*" cfg.default_level ;
+  let origin, rules = find_log_rules cfg.rules in
+  begin match rules with
+    | None -> Lwt.return_unit
+    | Some rules ->
+        try
+          Lwt_log_core.load_rules rules ~fail_on_error:true ;
+          Lwt.return_unit
+        with _ ->
+          Printf.ksprintf Lwt.fail_with
+            "Incorrect log rules defined in %s" origin
+  end >>= fun () ->
+  init ~template:cfg.template cfg.output
+
 let close () =
   Lwt_log.close !Lwt_log.default

src/lib_stdlib_unix/logging_unix.mli

@@ -37,7 +37,23 @@ module Output : sig
   val pp : Format.formatter -> t -> unit
 end
 
+type cfg = {
+  output : Output.t ;
+  default_level : Logging.level ;
+  rules : string option ;
+  template : Logging.template ;
+}
 
-val init: ?template:Logging.template -> Output.t -> unit Lwt.t
+val default_cfg : cfg
 
+val create_cfg :
+  ?output:Output.t ->
+  ?default_level:Logging.level ->
+  ?rules:string ->
+  ?template:Logging.template -> unit -> cfg
+
+val level_encoding : Logging.level Data_encoding.t
+val cfg_encoding : cfg Data_encoding.t
+
+val init: ?cfg:cfg -> unit -> unit Lwt.t
 val close: unit -> unit Lwt.t