1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
module SystemOperation = Types.SystemOperation
module PathAccess = Types.PathAccess
module PathPermission = Types.PathPermission
let as_pledge_promises system_operations accesses =
let promises = ListLabels.map ~f:Pledge.as_promise system_operations in
(promises @ if List.is_empty accesses then [] else [ "unveil" ])
|> StringLabels.concat ~sep:" "
;;
let%test _ =
as_pledge_promises
[ SystemOperation.StdinStdoutStderrAndBasicFunctionality ]
[ { PathAccess.permissions = [ PathPermission.CreateAndRemove ]; path = "xdd.txt" } ]
|> String.equal "stdio unveil"
;;
let%test _ = as_pledge_promises [] [] |> String.equal ""
let%test _ =
let open SystemOperation in
as_pledge_promises [ StdinStdoutStderrAndBasicFunctionality ] [] |> String.equal "stdio"
;;
let%test _ =
let open SystemOperation in
as_pledge_promises [ StdinStdoutStderrAndBasicFunctionality; ReadFromFilesystem ] []
|> String.equal "stdio rpath"
;;
let%test _ =
let open SystemOperation in
as_pledge_promises
[ StdinStdoutStderrAndBasicFunctionality ]
[ { PathAccess.permissions = [ PathPermission.Read ]; path = "xdd.txt" } ]
|> String.equal "stdio unveil"
;;
let%test _ =
let open SystemOperation in
as_pledge_promises
[ StdinStdoutStderrAndBasicFunctionality
; ReadFromFilesystem
; WriteToFilesystem
; CreateAndRemoveOnFilesystem
; TmpPath
; Networking
]
[]
|> String.equal "stdio rpath wpath cpath tmppath inet"
;;
external pledge_promises : string -> unit = "caml_openbsd_pledge_promises"
external unveil_add : string -> string -> unit = "caml_openbsd_unveil_add"
external unveil_lock : unit -> unit = "caml_openbsd_unveil_lock"
let run ~system_operations ~accesses main =
as_pledge_promises system_operations accesses |> pledge_promises;
ListLabels.iter
~f:(fun path_access ->
let open PathAccess in
Unveil.as_permissions path_access.permissions |> unveil_add path_access.path)
accesses;
if List.is_empty accesses then () else unveil_lock ();
main ()
;;