Client refactor: Move part of Logging into Logging_unix

src/bin_node/node_config_file.ml

@@ -46,7 +46,7 @@ and tls = {
 }
 
 and log = {
-  output : Logging.Output.t ;
+  output : Logging_unix.Output.t ;
   default_level : Logging.level ;
   rules : string option ;
   template : Logging.template ;
@@ -274,6 +274,27 @@ let rpc : rpc Data_encoding.t =
        (opt "crt" string)
        (opt "key" 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
@@ -282,8 +303,8 @@ let log =
     (fun (output, default_level, rules, template) ->
        { output ; default_level ; rules ; template })
     (obj4
-       (dft "output" Logging.Output.encoding default_log.output)
+       (dft "output" Logging_unix.Output.encoding default_log.output)
-       (dft "level" Logging.level_encoding default_log.default_level)
+       (dft "level" level_encoding default_log.default_level)
        (opt "rules" string)
        (dft "template" string default_log.template))
 
@@ -301,7 +322,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" Logging.level_encoding default_level)
+       (dft "worker_backlog_level" level_encoding default_level)
        (dft "worker_zombie_lifetime" float default_zombie_lifetime)
        (dft "worker_zombie_memory" float default_zombie_memory))
 

src/bin_node/node_config_file.mli

@@ -36,7 +36,7 @@ and tls = {
 }
 
 and log = {
-  output : Logging.Output.t ;
+  output : Logging_unix.Output.t ;
   default_level : Logging.level ;
   rules : string option ;
   template : Logging.template ;
@@ -72,7 +72,7 @@ val update:
   ?cors_origins:string list ->
   ?cors_headers:string list ->
   ?rpc_tls:tls ->
-  ?log_output:Logging.Output.t ->
+  ?log_output:Logging_unix.Output.t ->
   ?bootstrap_threshold:int ->
   t -> t tzresult Lwt.t
 

src/bin_node/node_run_command.ml

@@ -88,7 +88,7 @@ let init_logger ?verbosity (log_config : Node_config_file.log) =
             exit 1
         end
   end ;
-  Logging.init ~template:log_config.template log_config.output
+  Logging_unix.init ~template:log_config.template log_config.output
 
 let init_node ?sandbox (config : Node_config_file.t) =
   let patch_context json ctxt =
@@ -243,7 +243,7 @@ let run ?verbosity ?sandbox (config : Node_config_file.t) =
   lwt_log_notice "Shutting down the RPC server..." >>= fun () ->
   Lwt_utils.may ~f:RPC_server.shutdown rpc >>= fun () ->
   lwt_log_notice "BYE (%d)" x >>= fun () ->
-  Logging.close () >>= fun () ->
+  Logging_unix.close () >>= fun () ->
   return ()
 
 let process sandbox verbosity args =

src/bin_node/node_shared_arg.ml

@@ -31,7 +31,7 @@ type t = {
   cors_origins: string list ;
   cors_headers: string list ;
   rpc_tls: Node_config_file.tls option ;
-  log_output: Logging.Output.t option ;
+  log_output: Logging_unix.Output.t option ;
   bootstrap_threshold: int option ;
 }
 
@@ -106,10 +106,10 @@ end
 module Term = struct
 
   let log_output_converter =
-    (fun s -> match Logging.Output.of_string s with
+    (fun s -> match Logging_unix.Output.of_string s with
        | Some res -> `Ok res
        | None -> `Error s),
-    Logging.Output.pp
+    Logging_unix.Output.pp
 
   (* misc args *)
 

src/bin_node/node_shared_arg.mli

@@ -26,7 +26,7 @@ type t = {
   cors_origins: string list ;
   cors_headers: string list ;
   rpc_tls: Node_config_file.tls option ;
-  log_output: Logging.Output.t option ;
+  log_output: Logging_unix.Output.t option ;
   bootstrap_threshold: int option ;
 }
 

src/lib_p2p/test/test_p2p_io_scheduler.ml

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

src/lib_shell_services/worker_types.ml

@@ -7,6 +7,27 @@
 (*                                                                        *)
 (**************************************************************************)
 
+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
+
 type limits =
   { backlog_size : int ;
     backlog_level : Logging.level ;
@@ -90,7 +111,7 @@ let full_status_encoding req_encoding evt_encoding error_encoding =
   let events_encoding =
     list
       (obj2
-         (req "level" Logging.level_encoding)
+         (req "level" level_encoding)
          (req "events" (dynamic_size (list (dynamic_size evt_encoding))))) in
   let current_request_encoding =
     obj3

src/lib_stdlib_lwt/logging.ml

@@ -7,8 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Lwt.Infix
-
 module type LOG = sig
 
   val debug: ('a, Format.formatter, unit, unit) format4 -> 'a
@@ -28,21 +26,21 @@ module type LOG = sig
 end
 
 let log_f
-    ?exn ?(section = Lwt_log.Section.main) ?location ?logger ~level format =
+    ?exn ?(section = Lwt_log_core.Section.main) ?location ?logger ~level format =
-  if level < Lwt_log.Section.level section then
+  if level < Lwt_log_core.Section.level section then
     Format.ikfprintf (fun _ -> Lwt.return_unit) Format.std_formatter format
   else
     Format.kasprintf
-      (fun msg -> Lwt_log.log ?exn ~section ?location ?logger ~level msg)
+      (fun msg -> Lwt_log_core.log ?exn ~section ?location ?logger ~level msg)
       format
 
 let ign_log_f
-    ?exn ?(section = Lwt_log.Section.main) ?location ?logger ~level format =
+    ?exn ?(section = Lwt_log_core.Section.main) ?location ?logger ~level format =
-  if level < Lwt_log.Section.level section then
+  if level < Lwt_log_core.Section.level section then
     Format.ikfprintf (fun _ -> ()) Format.std_formatter format
   else
     Format.kasprintf
-      (fun msg -> Lwt_log.ign_log ?exn ~section ?location ?logger ~level msg)
+      (fun msg -> Lwt_log_core.ign_log ?exn ~section ?location ?logger ~level msg)
       format
 
 let sections = ref []
@@ -50,21 +48,21 @@ let sections = ref []
 module Make(S : sig val name: string end) : LOG = struct
 
   let () = sections := S.name :: !sections
-  let section = Lwt_log.Section.make S.name
+  let section = Lwt_log_core.Section.make S.name
 
-  let debug fmt = ign_log_f ~section ~level:Lwt_log.Debug fmt
+  let debug fmt = ign_log_f ~section ~level:Lwt_log_core.Debug fmt
-  let log_info fmt = ign_log_f ~section ~level:Lwt_log.Info fmt
+  let log_info fmt = ign_log_f ~section ~level:Lwt_log_core.Info fmt
-  let log_notice fmt = ign_log_f ~section ~level:Lwt_log.Notice fmt
+  let log_notice fmt = ign_log_f ~section ~level:Lwt_log_core.Notice fmt
-  let warn fmt = ign_log_f ~section ~level:Lwt_log.Warning fmt
+  let warn fmt = ign_log_f ~section ~level:Lwt_log_core.Warning fmt
-  let log_error fmt = ign_log_f ~section ~level:Lwt_log.Error fmt
+  let log_error fmt = ign_log_f ~section ~level:Lwt_log_core.Error fmt
-  let fatal_error fmt = ign_log_f ~section ~level:Lwt_log.Fatal fmt
+  let fatal_error fmt = ign_log_f ~section ~level:Lwt_log_core.Fatal fmt
 
-  let lwt_debug fmt = log_f ~section ~level:Lwt_log.Debug fmt
+  let lwt_debug fmt = log_f ~section ~level:Lwt_log_core.Debug fmt
-  let lwt_log_info fmt = log_f ~section ~level:Lwt_log.Info fmt
+  let lwt_log_info fmt = log_f ~section ~level:Lwt_log_core.Info fmt
-  let lwt_log_notice fmt = log_f ~section ~level:Lwt_log.Notice fmt
+  let lwt_log_notice fmt = log_f ~section ~level:Lwt_log_core.Notice fmt
-  let lwt_warn fmt = log_f ~section ~level:Lwt_log.Warning fmt
+  let lwt_warn fmt = log_f ~section ~level:Lwt_log_core.Warning fmt
-  let lwt_log_error fmt = log_f ~section ~level:Lwt_log.Error fmt
+  let lwt_log_error fmt = log_f ~section ~level:Lwt_log_core.Error fmt
-  let lwt_fatal_error fmt = log_f ~section ~level:Lwt_log.Fatal fmt
+  let lwt_fatal_error fmt = log_f ~section ~level:Lwt_log_core.Fatal fmt
 
 end
 
@@ -89,122 +87,6 @@ module Client = struct
   module Denunciation = Make(struct let name = "client.denunciation" end)
 end
 
-type template = Lwt_log.template
-let default_template = "$(date) - $(section): $(message)"
-
-module Output = struct
-
-  type t =
-    | Null
-    | Stdout
-    | Stderr
-    | File of string
-    | Syslog of Lwt_log.syslog_facility
-
-  let to_string : t -> string = function
-    | Null -> "/dev/null"
-    | Stdout -> "stdout"
-    | Stderr -> "stderr"
-    | File fp -> fp
-    | Syslog `Auth -> "syslog:auth"
-    | Syslog `Authpriv -> "syslog:authpriv"
-    | Syslog `Cron -> "syslog:cron"
-    | Syslog `Daemon -> "syslog:daemon"
-    | Syslog `FTP -> "syslog:ftp"
-    | Syslog `Kernel -> "syslog:kernel"
-    | Syslog `Local0 -> "syslog:local0"
-    | Syslog `Local1 -> "syslog:local1"
-    | Syslog `Local2 -> "syslog:local2"
-    | Syslog `Local3 -> "syslog:local3"
-    | Syslog `Local4 -> "syslog:local4"
-    | Syslog `Local5 -> "syslog:local5"
-    | Syslog `Local6 -> "syslog:local6"
-    | Syslog `Local7 -> "syslog:local7"
-    | Syslog `LPR -> "syslog:lpr"
-    | Syslog `Mail -> "syslog:mail"
-    | Syslog `News -> "syslog:news"
-    | Syslog `Syslog -> "syslog:syslog"
-    | Syslog `User -> "syslog:user"
-    | Syslog `UUCP -> "syslog:uucp"
-    | Syslog `NTP -> "syslog:ntp"
-    | Syslog `Security -> "syslog:security"
-    | Syslog `Console -> "syslog:console"
-
-  let of_string : string -> t = function
-    | "/dev/null" | "null" -> Null
-    | "stdout" -> Stdout
-    | "stderr" -> Stderr
-    | "syslog:auth" -> Syslog `Auth
-    | "syslog:authpriv" -> Syslog `Authpriv
-    | "syslog:cron" -> Syslog `Cron
-    | "syslog:daemon" -> Syslog `Daemon
-    | "syslog:ftp" -> Syslog `FTP
-    | "syslog:kernel" -> Syslog `Kernel
-    | "syslog:local0" -> Syslog `Local0
-    | "syslog:local1" -> Syslog `Local1
-    | "syslog:local2" -> Syslog `Local2
-    | "syslog:local3" -> Syslog `Local3
-    | "syslog:local4" -> Syslog `Local4
-    | "syslog:local5" -> Syslog `Local5
-    | "syslog:local6" -> Syslog `Local6
-    | "syslog:local7" -> Syslog `Local7
-    | "syslog:lpr" -> Syslog `LPR
-    | "syslog:mail" -> Syslog `Mail
-    | "syslog:news" -> Syslog `News
-    | "syslog:syslog" -> Syslog `Syslog
-    | "syslog:user" -> Syslog `User
-    | "syslog:uucp" -> Syslog `UUCP
-    | "syslog:ntp" -> Syslog `NTP
-    | "syslog:security" -> Syslog `Security
-    | "syslog:console" -> Syslog `Console
-    (* | s when start_with "syslog:" FIXME error or warning. *)
-    | fp ->
-        (* TODO check absolute path *)
-        File fp
-
-  let encoding =
-    let open Data_encoding in
-    conv to_string of_string string
-
-  let of_string str =
-    try
-      Some (Data_encoding.Json.destruct encoding (`String str))
-    with _ -> None
-
-  let to_string output =
-    match Data_encoding.Json.construct encoding output with
-    | `String res -> res
-    | #Data_encoding.json -> assert false
-
-  let pp fmt output =
-    Format.fprintf fmt "%s" (to_string output)
-end
-
-let init ?(template = default_template) output =
-  let open Output in
-  begin
-    match output with
-    | Stderr ->
-        Lwt.return @@
-        Lwt_log.channel ~template ~close_mode:`Keep ~channel:Lwt_io.stderr ()
-    | Stdout ->
-        Lwt.return @@
-        Lwt_log.channel ~template ~close_mode:`Keep ~channel:Lwt_io.stdout ()
-    | File file_name ->
-        Lwt_log.file ~file_name ~template ()
-    | Null ->
-        Lwt.return @@
-        Lwt_log.null
-    | Syslog facility ->
-        Lwt.return @@
-        Lwt_log.syslog ~template ~facility ()
-  end >>= fun logger ->
-  Lwt_log.default := logger ;
-  Lwt.return_unit
-
-let close () =
-  Lwt_log.close !Lwt_log.default
-
 type level = Lwt_log_core.level =
   | Debug
   (** Debugging message. They can be automatically removed by the
@@ -221,22 +103,5 @@ type level = Lwt_log_core.level =
       program. *)
   | Fatal
 
-let level_encoding =
+type template = Lwt_log_core.template
-  let open Data_encoding in
+let default_template = "$(date) - $(section): $(message)"
-  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

src/lib_stdlib_lwt/logging.mli

@@ -67,25 +67,4 @@ type level = Lwt_log_core.level =
 type template = Lwt_log.template
 val default_template : template
 
-val level_encoding : level Data_encoding.t
+val sections: string list ref
-
-module Output : sig
-  type t =
-    | Null
-    | Stdout
-    | Stderr
-    | File of string
-    | Syslog of Lwt_log.syslog_facility
-
-  val encoding : t Data_encoding.t
-  val of_string : string -> t option
-  val to_string : t -> string
-  val pp : Format.formatter -> t -> unit
-end
-
-
-val init: ?template:template -> Output.t -> unit Lwt.t
-
-val close: unit -> unit Lwt.t
-
-val sections : string list ref

src/lib_stdlib_lwt/logging_unix.ml

@@ -0,0 +1,123 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2018.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Lwt.Infix
+
+module Output = struct
+
+  type t =
+    | Null
+    | Stdout
+    | Stderr
+    | File of string
+    | Syslog of Lwt_log.syslog_facility
+
+  let to_string : t -> string = function
+    | Null -> "/dev/null"
+    | Stdout -> "stdout"
+    | Stderr -> "stderr"
+    | File fp -> fp
+    | Syslog `Auth -> "syslog:auth"
+    | Syslog `Authpriv -> "syslog:authpriv"
+    | Syslog `Cron -> "syslog:cron"
+    | Syslog `Daemon -> "syslog:daemon"
+    | Syslog `FTP -> "syslog:ftp"
+    | Syslog `Kernel -> "syslog:kernel"
+    | Syslog `Local0 -> "syslog:local0"
+    | Syslog `Local1 -> "syslog:local1"
+    | Syslog `Local2 -> "syslog:local2"
+    | Syslog `Local3 -> "syslog:local3"
+    | Syslog `Local4 -> "syslog:local4"
+    | Syslog `Local5 -> "syslog:local5"
+    | Syslog `Local6 -> "syslog:local6"
+    | Syslog `Local7 -> "syslog:local7"
+    | Syslog `LPR -> "syslog:lpr"
+    | Syslog `Mail -> "syslog:mail"
+    | Syslog `News -> "syslog:news"
+    | Syslog `Syslog -> "syslog:syslog"
+    | Syslog `User -> "syslog:user"
+    | Syslog `UUCP -> "syslog:uucp"
+    | Syslog `NTP -> "syslog:ntp"
+    | Syslog `Security -> "syslog:security"
+    | Syslog `Console -> "syslog:console"
+
+  let of_string : string -> t = function
+    | "/dev/null" | "null" -> Null
+    | "stdout" -> Stdout
+    | "stderr" -> Stderr
+    | "syslog:auth" -> Syslog `Auth
+    | "syslog:authpriv" -> Syslog `Authpriv
+    | "syslog:cron" -> Syslog `Cron
+    | "syslog:daemon" -> Syslog `Daemon
+    | "syslog:ftp" -> Syslog `FTP
+    | "syslog:kernel" -> Syslog `Kernel
+    | "syslog:local0" -> Syslog `Local0
+    | "syslog:local1" -> Syslog `Local1
+    | "syslog:local2" -> Syslog `Local2
+    | "syslog:local3" -> Syslog `Local3
+    | "syslog:local4" -> Syslog `Local4
+    | "syslog:local5" -> Syslog `Local5
+    | "syslog:local6" -> Syslog `Local6
+    | "syslog:local7" -> Syslog `Local7
+    | "syslog:lpr" -> Syslog `LPR
+    | "syslog:mail" -> Syslog `Mail
+    | "syslog:news" -> Syslog `News
+    | "syslog:syslog" -> Syslog `Syslog
+    | "syslog:user" -> Syslog `User
+    | "syslog:uucp" -> Syslog `UUCP
+    | "syslog:ntp" -> Syslog `NTP
+    | "syslog:security" -> Syslog `Security
+    | "syslog:console" -> Syslog `Console
+    (* | s when start_with "syslog:" FIXME error or warning. *)
+    | fp ->
+        (* TODO check absolute path *)
+        File fp
+
+  let encoding =
+    let open Data_encoding in
+    conv to_string of_string string
+
+  let of_string str =
+    try
+      Some (Data_encoding.Json.destruct encoding (`String str))
+    with _ -> None
+
+  let to_string output =
+    match Data_encoding.Json.construct encoding output with
+    | `String res -> res
+    | #Data_encoding.json -> assert false
+
+  let pp fmt output =
+    Format.fprintf fmt "%s" (to_string output)
+end
+
+let init ?(template = Logging.default_template) output =
+  let open Output in
+  begin
+    match output with
+    | Stderr ->
+        Lwt.return @@
+        Lwt_log.channel ~template ~close_mode:`Keep ~channel:Lwt_io.stderr ()
+    | Stdout ->
+        Lwt.return @@
+        Lwt_log.channel ~template ~close_mode:`Keep ~channel:Lwt_io.stdout ()
+    | File file_name ->
+        Lwt_log.file ~file_name ~template ()
+    | Null ->
+        Lwt.return @@
+        Lwt_log.null
+    | Syslog facility ->
+        Lwt.return @@
+        Lwt_log.syslog ~template ~facility ()
+  end >>= fun logger ->
+  Lwt_log.default := logger ;
+  Lwt.return_unit
+
+let close () =
+  Lwt_log.close !Lwt_log.default

src/lib_stdlib_lwt/logging_unix.mli

@@ -0,0 +1,27 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2018.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+module Output : sig
+  type t =
+    | Null
+    | Stdout
+    | Stderr
+    | File of string
+    | Syslog of Lwt_log.syslog_facility
+
+  val encoding : t Data_encoding.t
+  val of_string : string -> t option
+  val to_string : t -> string
+  val pp : Format.formatter -> t -> unit
+end
+
+
+val init: ?template:Logging.template -> Output.t -> unit Lwt.t
+
+val close: unit -> unit Lwt.t