From b0c65f40b1d3323626e93b2d55304d596ee78ff7 Mon Sep 17 00:00:00 2001 From: jutty Date: Thu, 8 May 2025 23:10:14 -0300 Subject: [PATCH] OCaml: Implement configuration parser, bind lexer tokens with schema --- ocaml/README.md | 45 ++++++++++++----------- ocaml/bin/main.ml | 16 ++++++++- ocaml/lib/parsers/argument.ml | 25 ++++++++----- ocaml/lib/parsers/config/lexer.ml | 2 +- ocaml/lib/parsers/config/lexer.mli | 14 +++++++- ocaml/lib/parsers/config/parser.ml | 55 +++++++++++++++++++++++++++++ ocaml/lib/parsers/config/parser.mli | 7 ++++ ocaml/lib/schema/schema.ml | 21 +++++++++-- ocaml/lib/system/package.ml | 9 ++--- ocaml/lib/system/process/command.ml | 22 ++++++++++++ ocaml/lib/utilities/aliases.ml | 1 + ocaml/test/cram.t | 11 ++++-- 12 files changed, 187 insertions(+), 41 deletions(-) create mode 100644 ocaml/lib/parsers/config/parser.ml create mode 100644 ocaml/lib/parsers/config/parser.mli diff --git a/ocaml/README.md b/ocaml/README.md index 6c350ce..9a8c5c5 100644 --- a/ocaml/README.md +++ b/ocaml/README.md @@ -14,38 +14,35 @@ Grammar v0.2: break = "\n" space = " " | "\t" -Written using the ISO 14977 EBNF Notation . In this grammar, `digit` implies `decimal digit`. +Written using the ISO 14977 EBNF Notation. - -Spaces between the key and the `=` operator are lexed but meaningless. Spaces between the `=` operator and the first non-space character of the value are lexed and considered as part of the value. Spaces before the key and between the value and the newline are not lexed. +In this grammar, `digit` implies `decimal digit`. Spaces between the key and the `=` operator are lexed but meaningless. Spaces between the `=` operator and the first non-space character of the value are lexed and considered as part of the value. Spaces before the key and between the value and the newline are not lexed. - Note: non-terminals `key` and `value` are ambiguous. - Resolved by specifying what character terminates each -See also: - ## Task list -- Comparison of BNF notations: -- W3C ABNF Notation: -- IETF RFC 5234 ABNF Notation (replaces 4234, 2234): - [ ] Spec requirements integration test coverage - [x] Add log function - [x] Output begins with ` [log] ` - [x] Only prints if `DEBUG` is set - [ ] Add interactive pkg tests (INS v0 B2.5) - - [ ] Get su command from `$XDG_CONFIG_HOME/tori/tori.conf` - - [ ] Default to `su -c` - - [ ] Validation - - [ ] Valid path or in `PATH` - - [ ] Executability - - ~~`true` exits with status 0 (see note 3)~~ - - [x] Add logging - - [x] Logs only if DEBUG is set - - [x] Print each command executed, not just package names - - [x] Case with no packages provided - - [x] Prints a message - - [x] MUST NOT run any system commands + - [x] Get su command from `$XDG_CONFIG_HOME/tori/tori.conf` + - [ ] Default to `su -c` + - [ ] Handle fatal `Sys_error` if `tori.conf` doesn't exist + - [ ] Handle checking `su -c` default with `which` when `tori.conf` exists but `su_command` is absent in it + - [ ] Properly handle a compose `su_command` such as `su -c` in `System.Package` + - [x] Validation + - [x] Valid path or in `PATH` + - [x] Executability + - ~~`true` exits with status 0 (see note 3)~~ + - [x] Add logging + - [x] Logs only if DEBUG is set + - [x] Print each command executed, not just package names + - [x] Case with no packages provided + - [x] Prints a message + - [x] MUST NOT run any system commands - [x] Unrecognized command: exit code 1 - [x] Command `user`: print the output of `whoami` - [x] Command `os`: print the OS name @@ -56,7 +53,7 @@ See also: - [ ] Simplify Reader - [ ] Additionals - - [ ] Create interface files + - [ ] Create remaining interface files - [ ] Expand unit tests coverage - [ ] Try out doc generation @@ -79,3 +76,9 @@ See also: without user input 3. As per item 3 above, INS v0.2 drops "run 'true' with exit code 0" from A3.4 +## References + +- ISO 14977 EBNF Notation: +- Comparison of BNF notations: +- W3C ABNF Notation: +- IETF RFC 5234 ABNF Notation (replaces 4234, 2234): diff --git a/ocaml/bin/main.ml b/ocaml/bin/main.ml index 8184ae5..4dfd434 100644 --- a/ocaml/bin/main.ml +++ b/ocaml/bin/main.ml @@ -1,9 +1,23 @@ open Tori.Utilities.Aliases +module ConfigLexer = Tori.Parsers.Config.Lexer +module ConfigParser = Tori.Parsers.Config.Parser + +let config_file = + ConfigLexer.read $ Unix.getenv "HOME" ^ "/.config/tori/tori.conf" + let () = + + (* TODO: extract *) + let tokens = ConfigLexer.scan config_file in + (* elog $ ConfigLexer.string_of_tokens tokens; *) + let config = ConfigParser.parse (List.concat tokens) in + (* elog $ ConfigParser.string_of_config config; *) + match Array.to_list Sys.argv with | _ :: tail -> - let future = Tori.Parsers.Argument.interpret Tori.Schema.seed tail in + let past = ConfigParser.apply Tori.Schema.origin config in + let future = Tori.Parsers.Argument.interpret past tail in if future.output.main <> "" then print_endline future.output.main; if future.output.log <> "" then elog future.output.log; exit future.meta.status diff --git a/ocaml/lib/parsers/argument.ml b/ocaml/lib/parsers/argument.ml index a70c90e..19e7727 100644 --- a/ocaml/lib/parsers/argument.ml +++ b/ocaml/lib/parsers/argument.ml @@ -1,12 +1,19 @@ let interpret (past : Schema.schema) (input : string list) : Schema.schema = - let future : Schema.schema = + let present : Schema.schema = { past with output = { past.output with main = "" } } in let say (message : string) : Schema.schema = - { future with output = { future.output with main = message } } + { present with output = { present.output with main = message } } in + let configured_present = System.Process.Command.check_su_command present in + + (* poor legibility, but otherwise flagged as non-exhaustive *) + match configured_present.meta.status with + | n when n <> 0 -> configured_present + | _ -> + (* TODO: return a schema with orders, instead of calling side-effects directly, making this more of a parser and less of a glorified switch @@ -17,17 +24,17 @@ let interpret (past : Schema.schema) (input : string list) : Schema.schema = | "user" :: _ -> say (System.Process.Reader.read [||] "whoami").output | "echo" :: tail -> say (String.concat " " tail) | ("version" | "-v" | "--version") :: _ -> - say (Schema.format_version future.meta.version) - | ("help" | "-h" | "--help") :: _ -> say future.meta.help.long + say (Schema.format_version present.meta.version) + | ("help" | "-h" | "--help") :: _ -> say present.meta.help.long | head :: _ -> { - future with + present with output = { - future.output with + present.output with main = - "Unrecognized command: " ^ head ^ "\n" ^ future.meta.help.short; + "Unknown command: " ^ head ^ "\n" ^ present.meta.help.short; }; - meta = { future.meta with status = 1 }; + meta = { present.meta with status = 1 }; } - | _ -> future + | _ -> present diff --git a/ocaml/lib/parsers/config/lexer.ml b/ocaml/lib/parsers/config/lexer.ml index 35cbc09..dc4ca8b 100644 --- a/ocaml/lib/parsers/config/lexer.ml +++ b/ocaml/lib/parsers/config/lexer.ml @@ -1,6 +1,6 @@ open Utilities.Aliases -type key = SuCommand | Unknown +type key = Schema.configuration_key type token = | Key of key | Equal diff --git a/ocaml/lib/parsers/config/lexer.mli b/ocaml/lib/parsers/config/lexer.mli index 4dfbf03..e24451f 100644 --- a/ocaml/lib/parsers/config/lexer.mli +++ b/ocaml/lib/parsers/config/lexer.mli @@ -1,4 +1,16 @@ -type token +type key = Schema.configuration_key + +type token = + | Key of key + | Equal + | Value of string + | Space + | LineBreak + | Unknown of char + | End + val read : string -> char list list val scan : char list list -> token list list val string_of_tokens : token list list -> string + +exception Malformed_source of string diff --git a/ocaml/lib/parsers/config/parser.ml b/ocaml/lib/parsers/config/parser.ml new file mode 100644 index 0000000..932b88d --- /dev/null +++ b/ocaml/lib/parsers/config/parser.ml @@ -0,0 +1,55 @@ +(* open Utilities.Aliases *) +open Lexer + +type schema = Schema.schema +type token = Lexer.token +type config = Schema.main + +let default_config: config = 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 update config key value: config = + match key with + | Schema.SuCommand -> + (* elog $ "[c.parser.update] Setting value '" ^ value ^ "'"; *) + { config with Schema.su_command = value } + | Unknown -> + (* elog $ "[c.parser.update] Dropping value: unknown key"; *) + config + +let parse tokens = + let rec parse_tokens tokens config ready_key = + match tokens with + | [] -> config + | Key key :: tail -> + (* elog $ "[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 ^ "'"; *) + (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; *) + parse_tokens tail config ready_key + | (Space|Equal|LineBreak|End) :: tail -> + parse_tokens tail config ready_key + + in + parse_tokens tokens default_config None + +let apply (origin: Schema.schema) (config: config): Schema.schema = + { origin with input = { + origin.input with configuration = { + origin.input.configuration with main = config + } + }} + +let string_of_config (config: config): string = + "su_command = " ^ config.su_command ^ "\n" ^ + "" diff --git a/ocaml/lib/parsers/config/parser.mli b/ocaml/lib/parsers/config/parser.mli new file mode 100644 index 0000000..c79296e --- /dev/null +++ b/ocaml/lib/parsers/config/parser.mli @@ -0,0 +1,7 @@ +type token = Lexer.token +type schema = Schema.schema +type config = Schema.main + +val parse : token list -> config +val apply : schema -> config -> schema +val string_of_config : config -> string diff --git a/ocaml/lib/schema/schema.ml b/ocaml/lib/schema/schema.ml index 5c325e6..8e6266c 100644 --- a/ocaml/lib/schema/schema.ml +++ b/ocaml/lib/schema/schema.ml @@ -9,9 +9,14 @@ type output = { main : string; log : string } type os = Unknown | FreeBSD | Void | Alpine type host = { os : os; name : string } -type schema = { meta : meta; output : output; host : host } +type configuration_key = SuCommand | Unknown +type main = { su_command : string; } +type configuration = { main : main; } +type input = { configuration: configuration; } -let seed : schema = { +type schema = { meta : meta; output : output; input : input; host : host } + +let origin : schema = { meta = { version = { major = 0; @@ -24,6 +29,13 @@ let seed : schema = { }; status = 0; }; + input = { + configuration = { + main = { + su_command = "su -c" + }; + }; + }; output = { (* could be lists of strings or lists of a dedicated type with message, log level, time and origin in code (e.g. module and function) *) @@ -40,3 +52,8 @@ let format_version (version : version) : string = "v" ^ str_int version.major ^ "." ^ str_int version.minor ^ "." ^ str_int version.patch + +let string_of_key key = + match key with + | SuCommand -> "su_command" + | Unknown -> "" diff --git a/ocaml/lib/system/package.ml b/ocaml/lib/system/package.ml index 849ff75..ab2a67c 100644 --- a/ocaml/lib/system/package.ml +++ b/ocaml/lib/system/package.ml @@ -6,16 +6,17 @@ let merge (schema : Schema.schema) (packages : string list) : Schema.schema = output = { schema.output with main = "No packages provided" }; } | _ -> + let su_command = schema.input.configuration.main.su_command in let commands : Process.Command.command list = [ { - name = "doas"; - arguments = [ "doas"; "apk"; "-i"; "add" ] @ packages; + name = su_command; + arguments = [ su_command; "apk"; "-i"; "add" ] @ packages; status = Unevaluated; }; { - name = "doas"; - arguments = [ "doas"; "apk"; "-i"; "del" ] @ packages; + name = su_command; + arguments = [ su_command; "apk"; "-i"; "del" ] @ packages; status = Unevaluated; }; ] diff --git a/ocaml/lib/system/process/command.ml b/ocaml/lib/system/process/command.ml index 6ed623d..638da19 100644 --- a/ocaml/lib/system/process/command.ml +++ b/ocaml/lib/system/process/command.ml @@ -1,8 +1,11 @@ open Utilities.Aliases +type schema = Schema.schema + type status = Exit of int | Unevaluated type command = { name : string; arguments : string list; status : status } + let format (command : command) : string = command.name ^ " with arguments: " ^ String.concat " " command.arguments @@ -14,3 +17,22 @@ let format (command : command) : string = let format_many (commands : command list) : string list = List.map format commands + +let check_su_command (schema: schema): schema = + let command = schema.input.configuration.main.su_command in + let path = Reader.read [||] ("which " ^ command) in + try Unix.access path.output [Unix.X_OK]; schema + with Unix.Unix_error _ -> elog ""; + { + schema with + output = + { + schema.output with + main = + "Super user command " ^ command ^ + " not executable at path '" ^ path.output ^ + "' (exit status " ^ path.status ^ ", stderr: '" ^ + path.error ^ "')\n" + }; + meta = { schema.meta with status = 1 }; + } diff --git a/ocaml/lib/utilities/aliases.ml b/ocaml/lib/utilities/aliases.ml index 10bae6d..6c2e4b7 100644 --- a/ocaml/lib/utilities/aliases.ml +++ b/ocaml/lib/utilities/aliases.ml @@ -8,6 +8,7 @@ let elog = Log.elog let str_int = string_of_int let chars_str = Text.chars_of_string let str_chars = Text.string_of_chars +let str_char = String.make 1 (* control flow & precedence *) let ($) = (@@) diff --git a/ocaml/test/cram.t b/ocaml/test/cram.t index 74ed372..161fb2b 100644 --- a/ocaml/test/cram.t +++ b/ocaml/test/cram.t @@ -1,4 +1,4 @@ -This file tests this tori implementation against the Iganaq Napkin Spec v0.1 +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] ' @@ -8,6 +8,14 @@ A2. 'log' MUST print only if DEBUG is set and MUST be preceded by ' [log] ' $ echo "$with_debug" | grep -Fq " [log] " $ echo "$without_debug" | grep -Fqv " [log] " +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 + $ echo 'su_command=doas' > $HOME/.config/tori/tori.conf + $ ! which doas >/dev/null || tori smoke 2>&1 >/dev/null + B2.1. version | -v | --version -> MUST print the version as in v0.8.0 $ tori version @@ -72,4 +80,3 @@ a newline, '' and exit with status code 1 Unrecognized command: unrecognized_command [1] -