From d6b3e80cab8deeb2651dc8fe8349f08b9fc5dde2 Mon Sep 17 00:00:00 2001 From: Daniil Baturin Date: Fri, 23 Dec 2016 02:46:20 +0100 Subject: [PATCH 1/3] Add ?fail_on_error argument to Lwt_log_core.load_rules When set to true, it causes load_rules raise Failure if it fails to parse the rules, otherwise the behaviour remains the same for backwards compatibility. --- src/logger/lwt_log_core.ml | 48 ++++++++++++++++++++++--------------- src/logger/lwt_log_core.mli | 4 +++- 2 files changed, 32 insertions(+), 20 deletions(-) diff --git a/src/logger/lwt_log_core.ml b/src/logger/lwt_log_core.ml index 7b94f89655..2b9072890d 100644 --- a/src/logger/lwt_log_core.ml +++ b/src/logger/lwt_log_core.ml @@ -47,6 +47,17 @@ let string_of_level = function | Error -> "error" | Fatal -> "fatal" +let level_of_string str = + let str = (String.lowercase [@ocaml.warning "-3"]) str in + match str with + | "debug" -> Ok Debug + | "info" -> Ok Info + | "notice" -> Ok Notice + | "warning" -> Ok Warning + | "error" -> Ok Error + | "fatal" -> Ok Fatal + | _ -> Pervasives.Error (Printf.sprintf "invalid log level (%s)" str) + (* +-----------------------------------------------------------------+ | Patterns and rules | +-----------------------------------------------------------------+ *) @@ -101,31 +112,30 @@ let split pattern = in loop 0 - let rules = ref [] -let load_rules' str = +let load_rules' str fail_on_error = let rec loop = function - | [] -> - [] - | (pattern, level) :: rest -> - let pattern = split pattern in - match (String.lowercase [@ocaml.warning "-3"]) level with - | "debug" -> (pattern, Debug) :: loop rest - | "info" -> (pattern, Info) :: loop rest - | "notice" -> (pattern, Notice) :: loop rest - | "warning" -> (pattern, Warning) :: loop rest - | "error" -> (pattern, Error) :: loop rest - | "fatal" -> (pattern, Fatal) :: loop rest - | level -> log_intern "invalid log level (%s)" level; loop rest + | [] -> [] + | (pattern, level_str) :: rest -> + let pattern = split pattern in + let level = level_of_string level_str in + match level with + | Ok level -> (pattern, level) :: loop rest + | Pervasives.Error msg -> + if fail_on_error then raise (Failure msg) + else log_intern "invalid log level (%s)" level_str; loop rest in match Lwt_log_rules.rules (Lexing.from_string str) with - | None -> Printf.eprintf "Invalid contents of the LWT_LOG variable\n%!" - | Some l -> rules := loop l + | None -> + if fail_on_error then raise (Failure "Invalid log rules") + else Printf.eprintf "Invalid contents of the LWT_LOG variable\n%!" + | Some l -> rules := loop l + let _ = match try Some(Sys.getenv "LWT_LOG") with Not_found -> None with - | Some str -> load_rules' str + | Some str -> load_rules' str false | None -> () (* +-----------------------------------------------------------------+ @@ -197,8 +207,8 @@ end type section = Section.t -let load_rules str = - load_rules' str; +let load_rules ?(fail_on_error=false) str = + load_rules' str fail_on_error; Section.recompute_levels () let add_rule pattern level = diff --git a/src/logger/lwt_log_core.mli b/src/logger/lwt_log_core.mli index d4749bb628..f928d15d72 100644 --- a/src/logger/lwt_log_core.mli +++ b/src/logger/lwt_log_core.mli @@ -86,7 +86,9 @@ type section val string_of_level : level -> string -val load_rules : string -> unit +val level_of_string : string -> (level, string) result + +val load_rules : ?fail_on_error:bool -> string -> unit (** Reset the rules set when parsing the [LWT_LOG] environment variable using this string. *) From b91b2b267af170e20533516b029b5583c891f9b7 Mon Sep 17 00:00:00 2001 From: Daniil Baturin Date: Fri, 23 Dec 2016 17:21:57 +0100 Subject: [PATCH 2/3] Add a docstring for load_rules Make level_of_string : string -> level option instead of (level, string) result Remove references to LWT_LOG env variable from messages. --- src/logger/lwt_log_core.ml | 22 +++++++++++----------- src/logger/lwt_log_core.mli | 23 +++++++++++++++++++++-- 2 files changed, 32 insertions(+), 13 deletions(-) diff --git a/src/logger/lwt_log_core.ml b/src/logger/lwt_log_core.ml index 2b9072890d..5f5dc24d04 100644 --- a/src/logger/lwt_log_core.ml +++ b/src/logger/lwt_log_core.ml @@ -50,13 +50,13 @@ let string_of_level = function let level_of_string str = let str = (String.lowercase [@ocaml.warning "-3"]) str in match str with - | "debug" -> Ok Debug - | "info" -> Ok Info - | "notice" -> Ok Notice - | "warning" -> Ok Warning - | "error" -> Ok Error - | "fatal" -> Ok Fatal - | _ -> Pervasives.Error (Printf.sprintf "invalid log level (%s)" str) + | "debug" -> Some Debug + | "info" -> Some Info + | "notice" -> Some Notice + | "warning" -> Some Warning + | "error" -> Some Error + | "fatal" -> Some Fatal + | _ -> None (* +-----------------------------------------------------------------+ | Patterns and rules | @@ -121,15 +121,15 @@ let load_rules' str fail_on_error = let pattern = split pattern in let level = level_of_string level_str in match level with - | Ok level -> (pattern, level) :: loop rest - | Pervasives.Error msg -> - if fail_on_error then raise (Failure msg) + | Some level -> (pattern, level) :: loop rest + | None -> + if fail_on_error then raise (Failure "Invalid log rules") else log_intern "invalid log level (%s)" level_str; loop rest in match Lwt_log_rules.rules (Lexing.from_string str) with | None -> if fail_on_error then raise (Failure "Invalid log rules") - else Printf.eprintf "Invalid contents of the LWT_LOG variable\n%!" + else Printf.eprintf "Invalid log rules\n%!" | Some l -> rules := loop l diff --git a/src/logger/lwt_log_core.mli b/src/logger/lwt_log_core.mli index f928d15d72..4eed18f7b3 100644 --- a/src/logger/lwt_log_core.mli +++ b/src/logger/lwt_log_core.mli @@ -86,11 +86,30 @@ type section val string_of_level : level -> string -val level_of_string : string -> (level, string) result +val level_of_string : string -> level option val load_rules : ?fail_on_error:bool -> string -> unit (** Reset the rules set when parsing the [LWT_LOG] environment variable using this - string. *) + string. + + @param fail_on_error defines if the function will raise Failure if + it encounters a malformed rule + @raise Failure if an invalid rule is found and [fail_on_error] is true + + [load_rules] parses the rules string and validates the rules before loading them. + If [fail_on_error] is [true], invalid rules will cause this function to + raise [Failure] and leave existing rules unchanged. + If [fail_on_error] is [false] (this is the default), it tries to load as + many rules as possible ang ignore invalid ones. + If the rules string itself cannot be parsed, existing rules are always left + unchanged. + + Example: + {[ + Lwt_log_core.load_rules ~fail_on_error:true "* -> nosuchlevel" (* Raises Failure *) + Lwt_log_core.load_rules "* -> info" + ]} + *) val add_rule : string -> level -> unit (** [add_rule pattern level] adds a rule for sections logging From 0679de370c6192c009e70e91c510fc71797d27cb Mon Sep 17 00:00:00 2001 From: Daniil Baturin Date: Fri, 23 Dec 2016 18:03:26 +0100 Subject: [PATCH 3/3] Fix a typom flush code lines to the left. --- src/logger/lwt_log_core.mli | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/logger/lwt_log_core.mli b/src/logger/lwt_log_core.mli index 4eed18f7b3..f338224d75 100644 --- a/src/logger/lwt_log_core.mli +++ b/src/logger/lwt_log_core.mli @@ -100,14 +100,14 @@ val load_rules : ?fail_on_error:bool -> string -> unit If [fail_on_error] is [true], invalid rules will cause this function to raise [Failure] and leave existing rules unchanged. If [fail_on_error] is [false] (this is the default), it tries to load as - many rules as possible ang ignore invalid ones. + many rules as possible and ignore invalid ones. If the rules string itself cannot be parsed, existing rules are always left unchanged. Example: {[ - Lwt_log_core.load_rules ~fail_on_error:true "* -> nosuchlevel" (* Raises Failure *) - Lwt_log_core.load_rules "* -> info" +Lwt_log_core.load_rules ~fail_on_error:true "* -> nosuchlevel" (* Raises Failure *) +Lwt_log_core.load_rules "* -> info" ]} *)