jutty/tori-rs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

OCaml: Implement configuration parser, bind lexer tokens with schema

Browse source
This commit is contained in:
Juno Takano 2025-05-08 23:10:14 -03:00
commit b0c65f40b1
12 changed files with 187 additions and 41 deletions
Download patch file Download diff file Expand all files Collapse all files

45
ocaml/README.md
View file

@ -14,38 +14,35 @@ Grammar v0.2:
break = "\n"
space = " " | "\t"
Written using the ISO 14977 EBNF Notation <https://www.cl.cam.ac.uk/~mgk25/iso-14977.pdf>. 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: <https://www.cs.man.ac.uk/~pjj/bnf/ebnf.html>
- W3C ABNF Notation: <https://www.w3.org/Notation.html>
- IETF RFC 5234 ABNF Notation (replaces 4234, 2234): <https://www.rfc-editor.org/rfc/rfc5234>
- [ ] 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: <https://www.cl.cam.ac.uk/~mgk25/iso-14977.pdf>
- Comparison of BNF notations: <https://www.cs.man.ac.uk/~pjj/bnf/ebnf.html>
- W3C ABNF Notation: <https://www.w3.org/Notation.html>
- IETF RFC 5234 ABNF Notation (replaces 4234, 2234): <https://www.rfc-editor.org/rfc/rfc5234>

16
ocaml/bin/main.ml
View file

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

25
ocaml/lib/parsers/argument.ml
View file

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

2
ocaml/lib/parsers/config/lexer.ml
View file

@ -1,6 +1,6 @@
open Utilities.Aliases
type key = SuCommand | Unknown
type key = Schema.configuration_key
type token =
| Key of key
| Equal

14
ocaml/lib/parsers/config/lexer.mli
View file

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

55
ocaml/lib/parsers/config/parser.ml Normal file
View file

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

7
ocaml/lib/parsers/config/parser.mli Normal file
View file

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

21
ocaml/lib/schema/schema.ml
View file

@ -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 -> "<unknown key>"

9
ocaml/lib/system/package.ml
View file

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

22
ocaml/lib/system/process/command.ml
View file

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

1
ocaml/lib/utilities/aliases.ml
View file

@ -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 ($) = (@@)

11
ocaml/test/cram.t
View file

@ -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, '<short help>' and exit with status code 1
Unrecognized command: unrecognized_command
<short help>
[1]