tori/iganaq
tori/iganaq
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

OCaml: Handle some edge cases; refactor parser, main.ml; add config fetcher

Browse source
This commit is contained in:
Juno Takano 2025-05-09 11:19:27 -03:00
commit cb56da1462
16 changed files with 229 additions and 105 deletions
Download patch file Download diff file Expand all files Collapse all files

8
ocaml/lib/system/file.ml
View file

@ -1,3 +1,5 @@
open Utilities.Aliases
let read_channel channel =
let buffer = Buffer.create 4096 in
let rec read () =
@ -8,6 +10,12 @@ let read_channel channel =
in
try read () with End_of_file -> Buffer.contents buffer
let can_read (path: string): bool =
try Unix.access path [Unix.R_OK]; true
with Unix.Unix_error _ ->
elog $ "Failed to read file " ^ path;
false
let read path =
let channel = open_in path in
read_channel channel

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

@ -1,3 +1,7 @@
open Utilities.Aliases
let su = Process.Su.elevate_wrapped
let merge (schema : Schema.schema) (packages : string list) : Schema.schema =
match packages with
| [] ->
@ -6,17 +10,18 @@ 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 su_command_line = schema.input.configuration.main.su_command in
let su_command = Process.Su.head_of_su_command su_command_line in
let commands : Process.Command.command list =
[
{
name = su_command;
arguments = [ su_command; "apk"; "-i"; "add" ] @ packages;
arguments = su schema $ [ "apk"; "-i"; "add" ] @ packages;
status = Unevaluated;
};
{
name = su_command;
arguments = [ su_command; "apk"; "-i"; "del" ] @ packages;
arguments = su schema $ [ "apk"; "-i"; "del" ] @ packages;
status = Unevaluated;
};
]

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

@ -17,22 +17,3 @@ 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 };
}

34
ocaml/lib/system/process/su.ml Normal file
View file

@ -0,0 +1,34 @@
open Utilities.Aliases
type schema = Schema.schema
let head_of_su_command command_line =
match command_line with
| head :: _ -> head
| [] -> raise $ Malformed_source "su_command is set to an empty value"
let elevate_wrapped (schema: schema) (command: string list): string list =
let su_command = schema.input.configuration.main.su_command in
match schema.input.configuration.main.su_command_quoted with
| true|Default -> List.concat [ su_command; [(String.concat " " command)]; ]
| false -> List.concat [ su_command; ["--"]; (command); ]
let is_executable (schema: schema): schema =
let command = head_of_su_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 =
"The configured super user command " ^ command ^
" either could not be found at path '" ^ path.output ^
"' or you lack permissions to execute it ("
^ path.status ^ ", stderr: '" ^ path.error ^ "')\n"
};
meta = { schema.meta with status = 1; error_level = Fatal };
}