diff --git a/ocaml/README.md b/ocaml/README.md index f8646c4..b414ee5 100644 --- a/ocaml/README.md +++ b/ocaml/README.md @@ -33,6 +33,7 @@ In this grammar, `digit` implies `decimal digit`. Spaces between the key and the - [x] Handle checking `su -c` default with `which` when `tori.conf` exists but `su_command` is absent in it - [x] Properly handle a compose `su_command` such as `su -c` in `System.Package` - [x] Properly handle dependent options + - [x] Implement log levels - [ ] Write tests - [x] Validation - [x] Valid path or in `PATH` diff --git a/ocaml/dune-workspace b/ocaml/dune-workspace index 420caa9..8b6c24c 100644 --- a/ocaml/dune-workspace +++ b/ocaml/dune-workspace @@ -1,4 +1,4 @@ (lang dune 3.17) (context default) -(env (dev (flags (:standard -w +A-23-40-42)))) +(env (dev (flags (:standard -w +A-23-40-42-48-70)))) diff --git a/ocaml/lib/parsers/argument.ml b/ocaml/lib/parsers/argument.ml index 3be10c8..b706919 100644 --- a/ocaml/lib/parsers/argument.ml +++ b/ocaml/lib/parsers/argument.ml @@ -23,7 +23,7 @@ let interpret (past : Schema.schema) (arguments : string list) : Schema.schema = { past.output with main = - "Unknown command: " ^ head ^ "\n" ^ past.meta.help.short; + "Unrecognized command: " ^ head ^ "\n" ^ past.meta.help.short; }; meta = { past.meta with status = 1 }; } diff --git a/ocaml/lib/parsers/config/lexer.ml b/ocaml/lib/parsers/config/lexer.ml index d977519..b4cc960 100644 --- a/ocaml/lib/parsers/config/lexer.ml +++ b/ocaml/lib/parsers/config/lexer.ml @@ -98,5 +98,5 @@ let scan_line (input: char list): token list = let scan (char_lists: char lists): token lists = let tokens = rmap (scan_line) char_lists $: [End] in - elog $ string_of_tokens tokens; + elog ~context:Parsing $ string_of_tokens tokens; tokens diff --git a/ocaml/lib/parsers/config/parser.ml b/ocaml/lib/parsers/config/parser.ml index 39cf8ff..0e5cd4e 100644 --- a/ocaml/lib/parsers/config/parser.ml +++ b/ocaml/lib/parsers/config/parser.ml @@ -1,14 +1,8 @@ -(* open Utilities.Aliases *) open Lexer open Utilities.Aliases let default_config: Schema.main = Schema.origin.input.configuration.main -(* - TODO: The `elog` calls in this module's functions cause cram tests - to fail. Separate logging levels can be implemented to solve this. -*) - let parse_boolean (key: key) (value: string): Schema.default_bool = match value with | "true" -> true @@ -16,7 +10,7 @@ let parse_boolean (key: key) (value: string): Schema.default_bool = | _ -> raise $ Malformed_source (Schema.string_of_key key ^ " must be either true or false") -let check_sanity (config: Schema.main): Schema.main = +let check (config: Schema.main): Schema.main = let default = Schema.origin.input.configuration.main in @@ -24,20 +18,20 @@ let check_sanity (config: Schema.main): Schema.main = and default to unquoted if a custom su_command is set *) match config.su_command_quoted, config.su_command with | (true|false), su_command when su_command == default.su_command -> - elog $ "[c.parser.check_sanity] " ^ + elog ~context:Parsing $ "[c.parser.check] " ^ "Ignoring configuration key su_command_quoted: su_command is unset," ^ " and the default su_command needs quoting"; { config with su_command_quoted = default.su_command_quoted } | (true|false), _ -> config | Default, su_command when su_command <> default.su_command -> - elog $ "[c.parser.check_sanity] " ^ + elog ~context:Parsing $ "[c.parser.check] " ^ "Setting su_command_quoted to false: su_command is set, but " ^ "su_command_quoted isn't. If it needs quoting, please set it to true"; { config with su_command_quoted = false } | Default, _ -> config let update config key (value: string): Schema.main = - elog $ "[c.parser.update] Matching value '" ^ value ^ "'"; + elog ~context:Parsing $ "[c.parser.update] Matching value '" ^ value ^ "'"; match key with | Schema.SuCommand -> { config with Schema.su_command = String.split_on_char ' ' value } @@ -45,7 +39,7 @@ let update config key (value: string): Schema.main = { config with Schema.su_command_quoted = parse_boolean key value } | Unknown -> - elog $ "[c.parser.update] Dropped value: unknown key"; + elog ~context:Parsing $ "[c.parser.update] Dropped value: unknown key"; config let parse tokens: Schema.main = @@ -53,23 +47,25 @@ let parse tokens: Schema.main = match tokens with | [] -> config | Key key :: tail -> - elog $ "[c.parser.parse ] Picked key '" ^ + elog ~context:Parsing $ "[c.parser.parse] Picked key '" ^ Schema.string_of_key key ^ "'"; parse_tokens tail config (Some key) | Value value :: tail -> - elog $ "[c.parser.parse ] Picked value '" ^ value ^ "'"; + elog ~context:Parsing $ + "[c.parser.parse] Picked value '" ^ value ^ "'"; (match ready_key with | Some key -> parse_tokens tail (update config key value) None | None -> raise $ Malformed_source "Value lacks preceding key") | Unknown char :: tail -> - elog $ "[c.parser.parse ] Dropping unknown token " ^ str_char char; + elog ~context:Parsing $ + "[c.parser.parse] Dropping unknown token " ^ str_char char; parse_tokens tail config ready_key | (Space|Equal|LineBreak|End) :: tail -> parse_tokens tail config ready_key in parse_tokens tokens default_config None - |> check_sanity + |> check let apply (origin: Schema.schema) (config: Schema.main): Schema.schema = { origin with input = { diff --git a/ocaml/lib/system/os.ml b/ocaml/lib/system/os.ml index ce1c6ad..a999792 100644 --- a/ocaml/lib/system/os.ml +++ b/ocaml/lib/system/os.ml @@ -2,7 +2,7 @@ let identify : string = let os_release = String.split_on_char '\n' (File.read "/etc/os-release") in - Utilities.Log.elog (String.concat "\n" os_release); + Utilities.Log.elog ~context:OS (String.concat "\n" os_release); let os_equals = List.find (String.starts_with ~prefix:"NAME=") os_release in match String.split_on_char '=' os_equals with diff --git a/ocaml/lib/utilities/log.ml b/ocaml/lib/utilities/log.ml index 0d2dc00..cee6c9c 100644 --- a/ocaml/lib/utilities/log.ml +++ b/ocaml/lib/utilities/log.ml @@ -1,4 +1,11 @@ -let elog (message : string) : unit = - let debug_flag = try Unix.getenv "DEBUG" with Not_found -> "" in +type context = Default | OS | Parsing - if debug_flag <> "" then prerr_endline @@ " [log] " ^ message +let elog ?(context: context option) (message : string) : unit = + + let debug_flag = try Unix.getenv "DEBUG" with Not_found -> "" in + let log () = prerr_endline @@ " [log] " ^ message in + + match context with + | None | Some Default -> if debug_flag <> "" then log () + | Some Parsing -> if debug_flag = "parsing" then log () + | Some OS -> if debug_flag = "os" then log () diff --git a/ocaml/test/cram.t b/ocaml/test/cram.t index 161fb2b..6fd618c 100644 --- a/ocaml/test/cram.t +++ b/ocaml/test/cram.t @@ -3,7 +3,7 @@ This file tests this tori implementation against the Iganaq Napkin Spec v0.2 A2. 'log' MUST print only if DEBUG is set and MUST be preceded by ' [log] ' $ without_debug=$(tori os 2>&1) - $ with_debug=$(DEBUG=1 tori os 2>&1) + $ with_debug=$(DEBUG=os tori os 2>&1) $ test "$without_debug" != "$with_debug" $ echo "$with_debug" | grep -Fq " [log] " $ echo "$without_debug" | grep -Fqv " [log] " @@ -12,9 +12,9 @@ A3.4. [config] su_command must be validated for presence at the provided path or a path obtained from $PATH and filesystem permission to execute $ echo 'su_command=sudo' > $HOME/.config/tori/tori.conf - $ ! which sudo >/dev/null || tori smoke 2>&1 >/dev/null + $ ! which sudo >/dev/null || tori 2>&1 >/dev/null $ echo 'su_command=doas' > $HOME/.config/tori/tori.conf - $ ! which doas >/dev/null || tori smoke 2>&1 >/dev/null + $ ! which doas >/dev/null || tori 2>&1 >/dev/null B2.1. version | -v | --version -> MUST print the version as in v0.8.0 @@ -48,7 +48,7 @@ B2.3. os -> MUST print the os name B2.3. os -> MUST log the contents of /etc/os-release - $ tori_os=$(DEBUG=1 tori os 2>&1) + $ tori_os=$(DEBUG=os tori os 2>&1) $ test -n "$tori_os" $ echo "$tori_os" | grep -qFf /etc/os-release