From 9e9a9566db46495e3c7473e664ce28fc811238e2 Mon Sep 17 00:00:00 2001 From: jutty Date: Sat, 17 May 2025 00:48:49 -0300 Subject: [PATCH] OCaml: Add simulate (dry run) configuration option --- ocaml/lib/parsers/config/lexer.ml | 3 +++ ocaml/lib/parsers/config/parser.ml | 18 ++++++------------ ocaml/lib/schema/schema.ml | 12 ++++++++++-- ocaml/lib/system/package.ml | 24 ++++++++++++++++++------ ocaml/lib/system/process/command.ml | 10 +++++----- 5 files changed, 42 insertions(+), 25 deletions(-) diff --git a/ocaml/lib/parsers/config/lexer.ml b/ocaml/lib/parsers/config/lexer.ml index cc2e96f..a005590 100644 --- a/ocaml/lib/parsers/config/lexer.ml +++ b/ocaml/lib/parsers/config/lexer.ml @@ -21,6 +21,8 @@ let lex_keyword (literal: string): token = match literal with | "su_command" -> Key SuCommand | "su_command_quoted" -> Key SuCommandQuoted + | "interactive" -> Key Interactive + | "simulate" -> Key Simulate | _ -> Key Unknown let lex_keyvalue (literal: string): token = Value literal @@ -31,6 +33,7 @@ let string_of_token (token: token): string = | SuCommand -> "[ KEY: su_command ]" | SuCommandQuoted -> "[ KEY: su_command_quoted ]" | Interactive -> " [ KEY: interactive ]" + | Simulate -> " [ KEY: simulate ]" | Unknown -> "[ UNKNOWN KEY ]") | Equal -> "[ OP: equal ]" | Value v -> "[ VAL: " ^ v ^ " ]" diff --git a/ocaml/lib/parsers/config/parser.ml b/ocaml/lib/parsers/config/parser.ml index faebe97..fcee48a 100644 --- a/ocaml/lib/parsers/config/parser.ml +++ b/ocaml/lib/parsers/config/parser.ml @@ -30,20 +30,14 @@ let check (config: Schema.main): Schema.main = { config with su_command_quoted = false } | Default, _ -> config -let update config key (value: string): Schema.main = +let update (config: Schema.main) (key: Lexer.key) (value: string): Schema.main = elog ~context:Parsing $ "[c.parser.update] Matching value '" ^ value ^ "'"; match key with - | Schema.SuCommand -> - { config with Schema.su_command = String.split_on_char ' ' value } - | SuCommandQuoted -> - { config with - Schema.su_command_quoted = parse_boolean key value } - | Interactive -> - { config with - Schema.interactive = bool_of_string value } - | Unknown -> - elog ~context:Parsing $ "[c.parser.update] Dropped value: unknown key"; - config + | SuCommand -> { config with su_command = String.split_on_char ' ' value } + | SuCommandQuoted -> { config with su_command_quoted = parse_boolean key value } + | Interactive -> { config with interactive = bool_of_string value } + | Simulate -> { config with simulate = bool_of_string value } + | Unknown -> elog ~context:Parsing $ "[c.parser.update] Dropped value: unknown key"; config let parse tokens: Schema.main = let rec parse_tokens tokens config ready_key = diff --git a/ocaml/lib/schema/schema.ml b/ocaml/lib/schema/schema.ml index 7b6329a..ae5ff19 100644 --- a/ocaml/lib/schema/schema.ml +++ b/ocaml/lib/schema/schema.ml @@ -17,11 +17,17 @@ type os = Unknown | FreeBSD | Void | Alpine type host = { os : os; name : string } type default_bool = Default | true | false -type configuration_key = SuCommand | SuCommandQuoted | Interactive | Unknown +type configuration_key = + | SuCommand + | SuCommandQuoted + | Interactive + | Simulate + | Unknown type main = { su_command : string list; su_command_quoted: default_bool; - interactive: bool + interactive: bool; + simulate: bool; } type configuration = { main : main; } type input = { configuration: configuration; } @@ -53,6 +59,7 @@ let origin : schema = { su_command = [ "su"; "-c" ]; su_command_quoted = Default; interactive = true; + simulate = false; }; }; }; @@ -78,6 +85,7 @@ let string_of_key key = | SuCommand -> "su_command" | SuCommandQuoted -> "su_command_quoted" | Interactive -> "interactive" + | Simulate -> "simulate" | Unknown -> "" let string_of_default_bool (b: default_bool): string = diff --git a/ocaml/lib/system/package.ml b/ocaml/lib/system/package.ml index 4e900d1..82d8692 100644 --- a/ocaml/lib/system/package.ml +++ b/ocaml/lib/system/package.ml @@ -1,7 +1,7 @@ open Utilities.Aliases -type install = { interactive: string list; batch: string list } -type manager = { install: install } +type command = { interactive: string list; batch: string list } +type manager = { install: command; remove: command } type manager_table = { apk: manager } let table: manager_table = { @@ -9,6 +9,10 @@ let table: manager_table = { install = { interactive = [ "apk"; "-i"; "add"; ]; batch = [ "apk"; "--no-interactive"; "add"; ]; + }; + remove = { + interactive = [ "apk"; "-i"; "del"; ]; + batch = [ "apk"; "--no-interactive"; "del"; ]; } } } @@ -35,20 +39,28 @@ let merge (schema : Schema.schema) (packages : string list) : Schema.schema = }; { name = su_command; - arguments = su schema $ manager.install.interactive @ packages; + arguments = su schema $ manager.remove.interactive @ packages; status = Unevaluated; }; ] in - let ran = Process.Fork.run_many commands in - let formatted_ran = Process.Command.format_many ran in + let simulate = schema.input.configuration.main.simulate in + let log_output = + if simulate then + "Would execute:\n" ^ + String.concat "\n" (Process.Command.format_many commands) + else + let ran = + if simulate then [] else Process.Fork.run_many commands in + "Executed:\n" ^ + String.concat "\n" (Process.Command.format_many ran) in { schema with output = { schema.output with - log = "Done:\n" ^ String.concat "\n" formatted_ran; + log = log_output; }; } diff --git a/ocaml/lib/system/process/command.ml b/ocaml/lib/system/process/command.ml index 975d202..575196d 100644 --- a/ocaml/lib/system/process/command.ml +++ b/ocaml/lib/system/process/command.ml @@ -5,15 +5,15 @@ 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 - ^ " and result " + ^ " (" ^ - match command.status with - | Exit n -> str_int n - | Unevaluated -> "Not evaluated" + (match command.status with + | Exit n -> "Exit status " ^ str_int n + | Unevaluated -> "Not evaluated") + ^ ")" let format_many (commands : command list) : string list = List.map format commands