balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Client refactor: Move part of Logging into Logging_unix

Browse Source
This commit is contained in:
Grégoire Henry 2018-02-08 10:51:01 +01:00
parent f61eed1a67
commit 7a3277e625
11 changed files with 228 additions and 192 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
src/bin_node/node_config_file.ml
View File

@ -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 "level" Logging.level_encoding default_log.default_level)
(dft "output" Logging_unix.Output.encoding default_log.output)
(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))

4
src/bin_node/node_config_file.mli
View File

@ -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

4
src/bin_node/node_run_command.ml
View File

@ -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 =

6
src/bin_node/node_shared_arg.ml
View File

@ -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 *)

2
src/bin_node/node_shared_arg.mli
View File

@ -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 ;
}

2
src/lib_p2p/test/test_p2p_io_scheduler.ml
View File

@ -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

23
src/lib_shell_services/worker_types.ml
View File

@ -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

177
src/lib_stdlib_lwt/logging.ml
View File

@ -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 =
if level < Lwt_log.Section.level section then
?exn ?(section = Lwt_log_core.Section.main) ?location ?logger ~level format =
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 =
if level < Lwt_log.Section.level section then
?exn ?(section = Lwt_log_core.Section.main) ?location ?logger ~level format =
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 log_info fmt = ign_log_f ~section ~level:Lwt_log.Info fmt
let log_notice fmt = ign_log_f ~section ~level:Lwt_log.Notice fmt
let warn fmt = ign_log_f ~section ~level:Lwt_log.Warning fmt
let log_error fmt = ign_log_f ~section ~level:Lwt_log.Error fmt
let fatal_error fmt = ign_log_f ~section ~level:Lwt_log.Fatal 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_core.Info 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_core.Warning 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_core.Fatal fmt
let lwt_debug fmt = log_f ~section ~level:Lwt_log.Debug fmt
let lwt_log_info fmt = log_f ~section ~level:Lwt_log.Info fmt
let lwt_log_notice fmt = log_f ~section ~level:Lwt_log.Notice fmt
let lwt_warn fmt = log_f ~section ~level:Lwt_log.Warning fmt
let lwt_log_error fmt = log_f ~section ~level:Lwt_log.Error fmt
let lwt_fatal_error fmt = log_f ~section ~level:Lwt_log.Fatal 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_core.Info 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_core.Warning 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_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 =
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 template = Lwt_log_core.template
let default_template = "$(date) - $(section): $(message)"

23
src/lib_stdlib_lwt/logging.mli
View File

@ -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
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
val sections: string list ref

123
src/lib_stdlib_lwt/logging_unix.ml Normal file
View File

@ -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

27
src/lib_stdlib_lwt/logging_unix.mli Normal file
View File

@ -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