OCaml: Add separate logging channels and a dedicated 'command' type

ocaml/TODO.md

@@ -1,6 +1,6 @@
 - [ ] Spec requirements integration test coverage
-    - [ ] Add log function
+    - [x] Add log function
-        - [ ] Output begins with ` [log] `
+        - [x] Output begins with ` [log] `
         - [ ] Only prints if `DEBUG` is set
     - [ ] Add interactive pkg tests (INS v0 B2.5)
         - [ ] Get su command from `$XDG_CONFIG_HOME/tori/tori.conf`
@@ -9,11 +9,11 @@
                 - [ ] Valid path or in `PATH`
                 - [ ] Executability
                 - [ ] `true` exits with status 0
-        - [ ] Add logging
+        - [x] Add logging
-            - [ ] Print each command executed, not just package names
+            - [x] Print each command executed, not just package names
-        - [ ] Case with no packages provided
+        - [x] Case with no packages provided
-            - [ ] Prints a message
+            - [x] Prints a message
-            - [ ] MUST NOT run any system commands
+            - [x] MUST NOT run any system commands
     - [x] Unrecognized command: exit code 1
     - [x] Command `user`: print the output of `whoami`
 
@@ -29,6 +29,8 @@
 ## Notes
 
 - INS = Iganaq Napkin Spec: <https://brew.bsd.cafe/tori/iganaq#specification>
-- Spec v0 requirement B2.5 "MUST NOT run any system commands" is only testable
+- INS v0 B2.5 "MUST NOT run any system commands" is only testable if we wrap
-  if we wrap command execution properly in e.g. a list containing all executed
+  command execution properly in e.g. a list containing all executed commands
-  commands and ensure no command is ever executed without being appended to it
+  and ensure no command is ever executed without being appended to it
+- INS v0 A3.4 "running 'true' with exit code 0" requires the user to input
+  their password every time. This should be dropped from the spec instead

ocaml/bin/main.ml

@@ -1,7 +1,10 @@
+open Tori.Utilities.Aliases
+
 let () =
     match Array.to_list Sys.argv with
     | _ :: tail ->
         let future = (Tori.Parsers.Argument.interpret Tori.Schema.seed tail) in
-        if future.output.message <> "" then print_endline future.output.message;
+        if future.output.main <> "" then print_endline future.output.main;
+        if future.output.log <> "" then elog future.output.log;
         exit future.meta.status
     | [] -> assert false

ocaml/lib/parsers/argument.ml

@@ -1,9 +1,9 @@
 let interpret (past: Schema.schema) (input: string list): Schema.schema =
 
-    let future = { past with output = { message = "" } } in
+    let future: Schema.schema = { past with output = { past.output with main = "" } } in
 
-    let say (message: string) =
+    let say (message: string): Schema.schema =
-        { future with output = { message = message } } in
+        { future with output = { future.output with main = message }} in
 
     (*
        TODO: return a schema with orders, instead of calling side-effects
@@ -20,7 +20,7 @@ let interpret (past: Schema.schema) (input: string list): Schema.schema =
     | head :: _ ->
         { future with
             output = {
-                message =
+                future.output with main =
                     ("Unrecognized command: " ^ head ^ "\n"
                         ^ future.meta.help.short)
             };

ocaml/lib/schema/schema.ml

@@ -4,12 +4,12 @@ type version = { major: int; minor: int; patch: int }
 type help = { short: string; long: string }
 type meta = { version: version; help: help; status: int }
 
-type output = { message: string; }
+type output = { main: string; log: string }
 
 type os = Unknown | FreeBSD | Void | Alpine
-type host = { os: os; name: string; }
+type host = { os: os; name: string }
 
-type schema = { meta: meta; output: output; host: host; }
+type schema = { meta: meta; output: output; host: host }
 
 let seed: schema = {
     meta = {
@@ -25,7 +25,10 @@ let seed: schema = {
         status = 0;
     };
     output = {
-        message = "";
+        (* 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) *)
+        main = "";
+        log = "";
     };
     host = {
         os = Unknown;

ocaml/lib/system/package.ml

@@ -1,15 +1,30 @@
-let merge (schema: Schema.schema) (packages: string list) =
+let merge (schema: Schema.schema) (packages: string list): Schema.schema =
 
     match packages with
-    | [] -> { schema with output = { message = "No packages provided" } }
+    | [] -> { schema with output = {
+        schema.output with main = "No packages provided" }
+    }
     | _ ->
 
-    let in_targets = List.flatten [["doas"; "apk"; "-i"; "add"]; packages] and
+        let commands: Process.Command.command list = [
-        out_targets = List.flatten [["doas"; "apk"; "-i"; "del"]; packages] in
+            {
+                name = "doas";
+                arguments = ["doas"; "apk"; "-i"; "add"] @ packages;
+                status = Unevaluated;
+            };
+            {
+                name = "doas";
+                arguments = ["doas"; "apk"; "-i"; "del"] @ packages;
+                status = Unevaluated;
+            }
+        ] in
 
-        Process.Fork.run "doas" in_targets;
+        let ran = Process.Fork.run_many commands in
-        Process.Fork.run "doas" out_targets;
+        let formatted_ran = Process.Command.format_many ran in
 
-        { schema with output = {
+        {
-            message = "Done: " ^ (String.concat "\n" packages)
+            schema with output = {
-        }}
+                schema.output with log =
+                    "Done:\n" ^ (String.concat "\n" formatted_ran)
+            }
+        }

ocaml/lib/system/process/command.ml

@@ -0,0 +1,13 @@
+open Utilities.Aliases
+
+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"
+
+let format_many (commands: command list): string list = List.map format commands

ocaml/lib/system/process/fork.ml

@@ -1,11 +1,9 @@
-open Utilities.Aliases
+let run (command: Command.command): Command.command =
-
-let run (command: string) (arguments: string list) =
     match Unix.fork () with
-    | 0 -> Unix.execvp command (Array.of_list arguments)
+    | 0 -> Unix.execvp command.name (Array.of_list command.arguments)
     | pid -> let (_, status) = Unix.waitpid [] pid in
         match status with
-        | Unix.WEXITED 0 -> ()
+        | WSTOPPED n | WSIGNALED n | WEXITED n -> { command with status = Exit n }
-        | Unix.WEXITED n -> print ("Process exited with code " ^ str_int n)
+
-        | Unix.WSIGNALED n -> print ("Process terminated by signal " ^ str_int n)
+let run_many (commands: Command.command list): Command.command list =
-        | Unix.WSTOPPED n -> print ("Process stopped by signal " ^ str_int n)
+    List.map run commands

ocaml/lib/utilities/aliases.ml

@@ -1,2 +1,3 @@
 let str_int = string_of_int
 let print = print_endline
+let elog = Log.elog

ocaml/lib/utilities/log.ml

@@ -0,0 +1 @@
+let elog message = prerr_endline @@ " [log] " ^ message