forked from
anil.recoil.org/monopam-myspace
My aggregated monorepo of OCaml code, automaintained
day11/build: extract opam knowledge from Run_in_layers via Oci_spec.t
The user-facing change is on Oci_spec: it now exposes a type t
representing a spec template, parameterized only by the rootfs path.
make returns t, and to_yojson / write take ~root to instantiate.
This separates "what container do I want" (known up-front) from
"where is the rootfs" (only known after the host-side mount step).
That separation lets Run_in_layers.run lose all of its hardcoded
opam-isms:
- No more container_env with HOME=/home/opam
- No more ~cwd:"/home/opam" / ~hostname:"builder" / ~network:true
- No more bash-wrapping of cmd:string into argv
- No more ~mounts parameter
The function now takes an Oci_spec.t directly and just calls
Oci_spec.write ~root:(Fpath.to_string merged) after mounting the
overlay. Its imports are now strictly Day11_container, Day11_layer,
Day11_exec — no Day11_opam_layer reference, no /home/opam mention.
The only thing still tying Run_in_layers to day11_build is the
Types.build_env reference.
Build_layer absorbed the opam-flavoured spec construction into a
new opam_build_spec helper (cwd /home/opam, env with HOME, network
on, bash-wrapped argv) and constructs the spec internally before
calling Run_in_layers.run. From the caller's perspective
Build_layer.build's signature is unchanged.
The doc-pipeline callers in generate.ml are unchanged: they still
go through Build_layer.build with a custom strategy, and the
opam-flavoured defaults happen to be exactly what odoc tools expect
(they live at /home/opam/doc-tools/bin/...).
Test files that used Oci_spec.make ~root:... and Oci_spec.write
were updated for the new template / instantiate split. The unit
tests that inspected the JSON pipe make_basic_spec () through a
small spec_to_json helper.
12 test suites green. End-to-end smoke build of logs.0.10.0 still
works; layer.json's timing record now reports a single prep_upper
phase instead of separate dump_state and chown entries (since
those moved out of Run_in_layers and into a Build_layer prep_upper
callback in an earlier commit on this same series).
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
+296
-175
+71
-18
day11/build/build_layer.ml
+71
-18
day11/build/build_layer.ml
···
33
33
{ Types.cmd = Printf.sprintf "opam-build -v %s%s" pkg_str patch_args;
34
34
cleanup = opam_build_cleanup }
35
35
36
+
(** Default container env for opam-build containers. *)
37
+
let opam_container_env = [
38
+
("PATH", "/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin");
39
+
("HOME", "/home/opam");
40
+
]
41
+
42
+
(** Build an OCI spec template for an opam-build container running
43
+
[cmd] via [bash -c]. The cwd, env, hostname, network, and argv
44
+
wrapping are all hardcoded to the values opam-build expects. *)
45
+
let opam_build_spec ~cmd ~mounts ~uid ~gid : Day11_container.Oci_spec.t =
46
+
Day11_container.Oci_spec.make
47
+
~cwd:"/home/opam"
48
+
~hostname:"builder"
49
+
~env:opam_container_env
50
+
~mounts
51
+
~network:true
52
+
~argv:[ "/usr/bin/env"; "bash"; "-c"; cmd ]
53
+
~uid ~gid
54
+
()
55
+
56
+
(** Default pre-mount prep for opam-build containers: write a
57
+
synthetic switch-state file from the lowers' packages dirs and
58
+
chown /home so the build user owns its home dir. *)
59
+
let opam_build_prep_upper env ~uid ~gid ~upper ~lowers =
60
+
let switch_rel = Fpath.(v "home" / "opam" / ".opam" / Types.switch
61
+
/ ".opam-switch") in
62
+
let packages_rel = Fpath.(switch_rel / "packages") in
63
+
let packages_dirs = List.filter_map (fun dir ->
64
+
let p = Fpath.(dir // packages_rel) in
65
+
if Bos.OS.Dir.exists p |> Result.get_ok then Some p else None
66
+
) lowers in
67
+
if packages_dirs <> [] then begin
68
+
let state_dir = Fpath.(upper // switch_rel) in
69
+
mkdir state_dir;
70
+
Day11_opam_layer.Opamh.dump_state packages_dirs
71
+
Fpath.(state_dir / "switch-state") |> ignore
72
+
end;
73
+
let home_dir = Fpath.(upper / "home") in
74
+
if Bos.OS.Dir.exists home_dir |> Result.get_ok then
75
+
ignore (Day11_exec.Sudo.run env
76
+
Bos.Cmd.(v "chown" % "-R" % Printf.sprintf "%d:%d" uid gid
77
+
% Fpath.to_string home_dir))
78
+
36
79
(** Read the build result from an existing layer.json. *)
37
80
let result_of_layer_json layer_json (node : Build.t) =
38
81
match Day11_layer.Meta.load layer_json with
···
77
120
on_extract ~layer_dir ~success:(exit_code = 0);
78
121
exit_code
79
122
123
+
(** Collect transitive dep layer dirs from a build node. *)
124
+
let collect_transitive_dep_dirs ~os_dir (node : Build.t) =
125
+
let seen = Hashtbl.create 16 in
126
+
let rec walk (b : Build.t) =
127
+
if not (Hashtbl.mem seen b.hash) then begin
128
+
Hashtbl.replace seen b.hash ();
129
+
List.iter walk b.deps
130
+
end
131
+
in
132
+
List.iter walk node.deps;
133
+
Hashtbl.fold (fun hash () acc ->
134
+
Day11_layer.Dir.path ~os_dir hash :: acc
135
+
) seen []
136
+
80
137
(** Main entry point. *)
81
138
let build env (benv : Types.build_env)
82
139
?(opam_repositories = []) ?(mounts = [])
83
-
?patches ?(skip_state_dump = false)
140
+
?patches ?build_dirs ?prep_upper
84
141
?(on_extract = fun ~layer_dir:_ ~success:_ -> ())
85
142
(node : Build.t)
86
143
?strategy () =
···
91
148
| Some s -> s
92
149
| None -> opam_build_strategy ?patches node.pkg
93
150
in
151
+
let dep_dirs = match build_dirs with
152
+
| Some dirs -> dirs
153
+
| None -> collect_transitive_dep_dirs ~os_dir node
154
+
in
155
+
let prep_upper = match prep_upper with
156
+
| Some f -> f
157
+
| None ->
158
+
opam_build_prep_upper env ~uid:benv.uid ~gid:benv.gid
159
+
in
94
160
let layer_dir = Build.dir ~os_dir node in
95
161
let layer_json = Fpath.(layer_dir / "layer.json") in
96
162
if Bos.OS.File.exists layer_json |> Result.get_ok then begin
···
100
166
end else begin
101
167
Log.info (fun m -> m "Building %s (%s)" pkg_str layer_name);
102
168
let lock_file = Fpath.(os_dir / (layer_name ^ ".lock")) in
103
-
let dep_dirs =
104
-
if skip_state_dump then []
105
-
else begin
106
-
let rec collect_deps (seen : (string, unit) Hashtbl.t) (b : Build.t) =
107
-
if not (Hashtbl.mem seen b.hash) then begin
108
-
Hashtbl.replace seen b.hash ();
109
-
List.iter (collect_deps seen) b.deps
110
-
end
111
-
in
112
-
let seen = Hashtbl.create 16 in
113
-
List.iter (collect_deps seen) node.deps;
114
-
Hashtbl.fold (fun hash () acc ->
115
-
Day11_layer.Dir.path ~os_dir hash :: acc
116
-
) seen []
117
-
end
118
-
in
119
169
let _lock_result =
120
170
Day11_exec.Dir_lock.with_lock ~marker_file:(Fpath.v "layer.json")
121
171
~lock_file layer_dir
···
144
194
| _ -> []
145
195
in
146
196
let all_mounts = repo_mounts @ patch_mounts @ mounts in
197
+
let spec = opam_build_spec ~cmd:strategy.cmd
198
+
~mounts:all_mounts ~uid:benv.uid ~gid:benv.gid
199
+
in
147
200
match Run_in_layers.run env benv ~build_dirs:dep_dirs
148
-
~mounts:all_mounts ~skip_state_dump strategy.cmd with
201
+
~prep_upper spec with
149
202
| Ok (run, upper, timing) ->
150
203
strategy.cleanup env upper;
151
204
let _exit_code =
+47
-12
day11/build/build_layer.mli
+47
-12
day11/build/build_layer.mli
···
11
11
and [repo state-*.cache] from an upper dir. Suitable for any layer
12
12
built with opam. *)
13
13
14
+
val opam_build_spec :
15
+
cmd:string ->
16
+
mounts:Day11_container.Mount.t list ->
17
+
uid:int -> gid:int ->
18
+
Day11_container.Oci_spec.t
19
+
(** Build an OCI spec template for a container that runs [cmd] via
20
+
[bash -c], with the cwd / env / hostname / network defaults that
21
+
opam-build expects:
22
+
- cwd [/home/opam]
23
+
- hostname ["builder"]
24
+
- env [PATH=...] and [HOME=/home/opam]
25
+
- network on
26
+
- argv [\["/usr/bin/env"; "bash"; "-c"; cmd\]] *)
27
+
28
+
val opam_build_prep_upper :
29
+
Eio_unix.Stdenv.base -> uid:int -> gid:int ->
30
+
upper:Fpath.t -> lowers:Fpath.t list -> unit
31
+
(** Standard pre-mount prep for an opam-build container:
32
+
- dumps a synthetic opam [switch-state] file from the lowers'
33
+
[.opam-switch/packages] directories into the upper, so opam
34
+
sees the union of all stacked deps as installed
35
+
- chowns [upper/home] to [uid:gid] so the build user owns its
36
+
home directory inside the merged rootfs
37
+
38
+
This is the default {!build} prep when [?prep_upper] is omitted.
39
+
Doc-pipeline callers supply their own (e.g. mkdir/chown of
40
+
[/home/opam/odoc-out] and [/home/opam/html] mount points)
41
+
instead. *)
42
+
14
43
val build :
15
44
Eio_unix.Stdenv.base ->
16
45
Types.build_env ->
17
46
?opam_repositories:Fpath.t list ->
18
47
?mounts:Day11_container.Mount.t list ->
19
48
?patches:Patches.t ->
20
-
?skip_state_dump:bool ->
49
+
?build_dirs:Fpath.t list ->
50
+
?prep_upper:(upper:Fpath.t -> lowers:Fpath.t list -> unit) ->
21
51
?on_extract:(layer_dir:Fpath.t -> success:bool -> unit) ->
22
52
Day11_opam_layer.Build.t ->
23
53
?strategy:Types.build_strategy ->
···
26
56
(** [build env benv ?on_extract node ()] builds [node] in a
27
57
container, writes its generic [layer.json], and calls
28
58
[on_extract] so the caller can write any domain-specific sidecar
29
-
files (e.g. [build.json] for opam package builds, [doc.json]
30
-
for odoc layers).
59
+
files.
31
60
32
-
[on_extract] is called once per build, after the layer's [fs/]
33
-
has been moved into place and [layer.json] has been written.
34
-
The [success] flag is true iff the build's exit status was 0.
35
-
On infrastructure failures (the container couldn't be launched
36
-
at all), [on_extract] is still called with [success:false] so
37
-
the caller can write a "failed" sidecar.
38
-
39
-
[on_extract] is NOT called on cache hits — those just touch
40
-
[last_used] and return.
61
+
@param build_dirs Override the dep layer directories stacked as
62
+
overlay lowers. By default ([None]), the function collects the
63
+
transitive deps of [node] from the cache. Pass [Some []] for
64
+
doc containers that don't need dep stacking and rely on
65
+
explicit bind mounts instead.
66
+
@param prep_upper Override the pre-mount prep callback. The
67
+
default is {!opam_build_prep_upper} (dump_state + chown
68
+
[/home]). Doc callers supply their own. The callback is invoked
69
+
with [upper] (the writable upper dir, before mount) and
70
+
[lowers] (the final lowerdir list including the base).
71
+
@param on_extract Called after a build's [fs/] has been moved
72
+
into place and [layer.json] written, with [success:true] iff
73
+
exit status was 0. Used by callers to write domain-specific
74
+
sidecars ([build.json] for opam package builds, [doc.json] for
75
+
odoc layers). NOT called on cache hits.
41
76
42
77
Default strategy is {!opam_build_strategy}. *)
+4
-4
day11/build/debug.ml
+4
-4
day11/build/debug.ml
···
94
94
let spec = Day11_container.Oci_spec.make
95
95
~cwd:"/home/opam"
96
96
~hostname:"debug" ~env:debug_env ~network:true
97
-
~root:(Fpath.to_string rootfs)
98
97
~argv:[ "/usr/bin/env"; "bash"; "-c"; source_cmd ]
99
98
~uid ~gid () in
100
-
ignore (Day11_container.Oci_spec.write temp_dir spec);
99
+
ignore (Day11_container.Oci_spec.write
100
+
~root:(Fpath.to_string rootfs) temp_dir spec);
101
101
let container_id = Printf.sprintf "debug-src-%d" (Unix.getpid ()) in
102
102
ignore (Day11_container.Runc.delete env container_id);
103
103
ignore (Day11_container.Runc.run env ~bundle:temp_dir ~container_id);
···
112
112
~terminal
113
113
~cwd:"/home/opam/src"
114
114
~hostname:"debug" ~env:debug_env ~network:true
115
-
~root:(Fpath.to_string rootfs)
116
115
~argv ~uid ~gid () in
117
-
ignore (Day11_container.Oci_spec.write session.temp_dir spec);
116
+
ignore (Day11_container.Oci_spec.write
117
+
~root:(Fpath.to_string rootfs) session.temp_dir spec);
118
118
let container_id = Printf.sprintf "debug-%d" (Unix.getpid ()) in
119
119
ignore (Day11_container.Runc.delete env container_id);
120
120
let result = match
+18
-63
day11/build/run_in_layers.ml
+18
-63
day11/build/run_in_layers.ml
···
6
6
let mkdir path =
7
7
Bos.OS.Dir.create ~path:true path |> ignore
8
8
9
-
let container_env = [
10
-
("PATH", "/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin");
11
-
("HOME", "/home/opam");
12
-
]
13
-
14
9
let _timed name f =
15
10
let t0 = Unix.gettimeofday () in
16
11
let r = f () in
···
30
25
r
31
26
32
27
let run env (benv : Types.build_env)
33
-
~build_dirs ?(mounts = []) ?(skip_state_dump = false) cmd =
34
-
let uid = benv.uid in
35
-
let gid = benv.gid in
28
+
~build_dirs ?prep_upper (spec : Day11_container.Oci_spec.t) =
36
29
let t_total = Unix.gettimeofday () in
37
30
let t_merge = ref 0. in
38
-
let t_dump = ref 0. in
39
-
let t_chown = ref 0. in
31
+
let t_prep = ref 0. in
40
32
let t_mount = ref 0. in
41
33
let t_runc = ref 0. in
42
34
let t_umount = ref 0. in
43
35
let t_cleanup = ref 0. in
44
36
let base_fs = Fpath.add_seg benv.base.dir "fs" in
45
-
let switch = Types.switch in
46
37
let temp_dir =
47
38
let tmp = Fpath.v (Filename.get_temp_dir_name ()) in
48
39
let name = Printf.sprintf "day11_run_%06x"
···
113
104
Log.err (fun m -> m "stack.merge failed: %s" e))
114
105
end;
115
106
(* layer_fs_dirs is the list of dep lowers in the order used in the
116
-
overlayfs mount (separate first, then merged-lower if any). It's
117
-
reused below by dump_state to walk per-dep packages dirs. *)
107
+
overlayfs mount (separate first, then merged-lower if any). It
108
+
is also passed to [prep_upper] so domain-aware callers can read
109
+
per-dep state from the lowers if they need to. *)
118
110
let layer_fs_dirs =
119
111
List.map (fun d -> Fpath.(d / "fs")) separate_dirs
120
112
@ (if did_merge then [ lower ] else [])
···
126
118
ignore (Day11_exec.Sudo.rm_rf env merged);
127
119
ignore (Bos.OS.File.delete Fpath.(temp_dir / "config.json"))
128
120
in
129
-
(* Dump switch-state from build layers and base image.
130
-
Skipped for doc containers which don't use opam-build. *)
131
-
if not skip_state_dump then
132
-
timed_to "dump_state" t_dump (fun () ->
133
-
let switch_rel = Fpath.(v "home" / "opam" / ".opam" / switch
134
-
/ ".opam-switch") in
135
-
let packages_rel = Fpath.(switch_rel / "packages") in
136
-
let packages_dirs = List.filter_map (fun dir ->
137
-
let p = Fpath.(dir // packages_rel) in
138
-
if Bos.OS.Dir.exists p |> Result.get_ok then Some p else None
139
-
) (layer_fs_dirs @ [ base_fs ]) in
140
-
if packages_dirs <> [] then begin
141
-
let state_dir = Fpath.(upper // switch_rel) in
142
-
mkdir state_dir;
143
-
Day11_opam_layer.Opamh.dump_state packages_dirs
144
-
Fpath.(state_dir / "switch-state") |> ignore
145
-
end);
146
-
(* Chown upper for overlay permissions *)
147
-
timed_to "chown upper" t_chown (fun () ->
148
-
let uid_gid = Printf.sprintf "%d:%d" uid gid in
149
-
let home_dir = Fpath.(upper / "home") in
150
-
if Bos.OS.Dir.exists home_dir |> Result.get_ok then
151
-
ignore (Day11_exec.Sudo.run env
152
-
Bos.Cmd.(v "chown" % "-R" % uid_gid % Fpath.to_string home_dir)));
153
-
(* Create mount point directories for doc containers in the upper
154
-
so they exist in the merged rootfs for runc bind mounts *)
155
-
if skip_state_dump then begin
156
-
let odoc_out = Fpath.(upper / "home" / "opam" / "odoc-out") in
157
-
let html = Fpath.(upper / "home" / "opam" / "html") in
158
-
mkdir odoc_out; mkdir html;
159
-
ignore (Day11_exec.Sudo.run env
160
-
Bos.Cmd.(v "chown" % Printf.sprintf "%d:%d" uid gid
161
-
% Fpath.to_string odoc_out % Fpath.to_string html))
162
-
end;
121
+
(* Caller-supplied prep work on the upper, before the mount.
122
+
This is where opam-aware callers write switch-state, chown
123
+
/home, mkdir mount points etc. — all the domain-specific
124
+
work that used to live in this function. *)
125
+
(match prep_upper with
126
+
| None -> ()
127
+
| Some f ->
128
+
timed_to "prep_upper" t_prep (fun () ->
129
+
f ~upper ~lowers:(layer_fs_dirs @ [ base_fs ])));
163
130
(* Mount overlay with all layers as separate lowers *)
164
131
let overlay_lowers = layer_fs_dirs @ [ base_fs ] in
165
132
let* () = timed_to "overlay mount" t_mount (fun () ->
166
133
Day11_container.Overlay.mount env
167
134
~lower:overlay_lowers ~upper ~work ~target:merged)
168
135
in
169
-
(* Run command — always clean up overlay + container *)
136
+
(* Run container — always clean up overlay + container *)
170
137
let run_result =
171
138
Fun.protect
172
139
~finally:(fun () ->
173
140
timed_to "overlay umount" t_umount (fun () ->
174
141
ignore (Day11_container.Overlay.umount env merged)))
175
142
(fun () ->
176
-
let spec =
177
-
Day11_container.Oci_spec.make
178
-
~cwd:"/home/opam"
179
-
~hostname:"builder"
180
-
~env:container_env
181
-
~mounts
182
-
~network:true
183
-
~root:(Fpath.to_string merged)
184
-
~argv:[ "/usr/bin/env"; "bash"; "-c"; cmd ]
185
-
~uid ~gid
186
-
()
187
-
in
188
-
let* () = Day11_container.Oci_spec.write temp_dir spec in
143
+
let* () = Day11_container.Oci_spec.write
144
+
~root:(Fpath.to_string merged) temp_dir spec in
189
145
let container_id =
190
146
Printf.sprintf "day11-%s-%d"
191
147
(String.sub (Fpath.basename temp_dir) 0
···
205
161
timed_to "cleanup internals" t_cleanup (fun () -> cleanup_internals ());
206
162
let timing : Day11_layer.Meta.timing = [
207
163
"merge", !t_merge;
208
-
"dump_state", !t_dump;
209
-
"chown", !t_chown;
164
+
"prep_upper", !t_prep;
210
165
"overlay_mount", !t_mount;
211
166
"runc_run", !t_runc;
212
167
"overlay_umount", !t_umount;
+40
-9
day11/build/run_in_layers.mli
+40
-9
day11/build/run_in_layers.mli
···
1
1
(** Run a command in a container with layers stacked.
2
2
3
-
Handles the full container lifecycle: stack base + build layers,
4
-
dump switch-state, mount overlay, run command via runc, clean up. *)
3
+
Handles the generic container lifecycle: stack base + build
4
+
layers as an overlayfs, optionally let the caller seed the upper
5
+
with domain-specific files via [~prep_upper], mount, run command
6
+
via runc, clean up.
7
+
8
+
This module knows nothing about opam, opam switches, or doc
9
+
generation. Domain-specific prep work (writing an opam
10
+
switch-state file, chowning home dirs, mkdir'ing mount points
11
+
for the container's bind mounts) is supplied by the caller via
12
+
the [~prep_upper] callback. *)
5
13
6
14
val run :
7
15
Eio_unix.Stdenv.base ->
8
16
Types.build_env ->
9
17
build_dirs:Fpath.t list ->
10
-
?mounts:Day11_container.Mount.t list ->
11
-
?skip_state_dump:bool ->
12
-
string ->
18
+
?prep_upper:(upper:Fpath.t -> lowers:Fpath.t list -> unit) ->
19
+
Day11_container.Oci_spec.t ->
13
20
(Day11_exec.Run.t * Fpath.t * Day11_layer.Meta.timing,
14
21
[> Rresult.R.msg ]) result
15
-
(** [run env benv ~build_dirs ?mounts cmd] runs [cmd] in a container
16
-
with [benv.base] and [build_dirs] stacked as an overlay,
17
-
executing as [benv.uid]/[benv.gid].
22
+
(** [run env benv ~build_dirs ?prep_upper spec] mounts an overlayfs
23
+
rootfs from [benv.base] + [build_dirs], optionally seeded by
24
+
[prep_upper], then runs the container described by [spec].
25
+
26
+
{b The lifecycle:}
27
+
+ Make a temp dir with upper/work/merged/lower subdirs.
28
+
+ Touch every dep layer (LRU bookkeeping).
29
+
+ Plan the lowerdir layout via {!Day11_layer.Stack.plan_lowerdir},
30
+
cp-merging excess layers if the mount-options string would
31
+
overflow PAGE_SIZE.
32
+
+ Call [prep_upper ~upper ~lowers] (if supplied) so the caller
33
+
can seed the upper with whatever files / chowns / mkdirs the
34
+
container will need. [lowers] is the final list of lowerdirs
35
+
in their mount order (separate dep dirs first, then merged
36
+
lower if any). The caller can read from these to populate the
37
+
upper based on dep contents (e.g. an opam switch-state file).
38
+
+ Mount overlayfs.
39
+
+ Instantiate [spec] with the merged path as the rootfs and
40
+
write [config.json] into the bundle dir.
41
+
+ Run runc.
42
+
+ Umount and clean up everything except [upper], which the
43
+
caller takes ownership of.
44
+
45
+
[spec] is a fully-described container template — every field
46
+
except the rootfs path is baked in. {!Day11_container.Oci_spec}
47
+
documents the defaults; the caller is responsible for choosing
48
+
cwd, env, hostname, network, mounts, and argv.
18
49
19
50
Returns [(run_result, upper_dir, timing)] on success. [timing]
20
-
records how long each phase took (merge, dump_state, overlay
51
+
records how long each phase took (merge, prep_upper, overlay
21
52
mount, runc run, cleanup, etc.). The caller is responsible for
22
53
extracting what they need from [upper_dir] and cleaning it up. *)
+29
-14
day11/container/oci_spec.ml
+29
-14
day11/container/oci_spec.ml
···
1
+
type t = {
2
+
terminal : bool;
3
+
cwd : string;
4
+
hostname : string;
5
+
env : (string * string) list;
6
+
mounts : Mount.t list;
7
+
network : bool;
8
+
argv : string list;
9
+
uid : int;
10
+
gid : int;
11
+
}
12
+
13
+
let make ?(terminal = false) ?(cwd = "/") ?(hostname = "container")
14
+
?(env = []) ?(mounts = []) ?(network = false)
15
+
~argv ~uid ~gid () : t =
16
+
{ terminal; cwd; hostname; env; mounts; network; argv; uid; gid }
17
+
1
18
let default_linux_caps = [
2
19
"CAP_CHOWN";
3
20
"CAP_DAC_OVERRIDE";
···
15
32
16
33
let strings xs = `List (List.map (fun x -> `String x) xs)
17
34
18
-
let make ?(terminal = false) ?(cwd = "/") ?(hostname = "container")
19
-
?(env = []) ?(mounts = []) ?(network = false)
20
-
~root ~argv ~uid ~gid () =
35
+
let to_yojson ~root (t : t) : Yojson.Safe.t =
21
36
`Assoc [
22
37
("ociVersion", `String "1.0.1-dev");
23
38
("process", `Assoc [
24
-
("terminal", `Bool terminal);
25
-
("user", `Assoc [ ("uid", `Int uid); ("gid", `Int gid) ]);
26
-
("args", strings argv);
39
+
("terminal", `Bool t.terminal);
40
+
("user", `Assoc [ ("uid", `Int t.uid); ("gid", `Int t.gid) ]);
41
+
("args", strings t.argv);
27
42
("env", strings (List.map (fun (k, v) ->
28
-
Printf.sprintf "%s=%s" k v) env));
29
-
("cwd", `String cwd);
43
+
Printf.sprintf "%s=%s" k v) t.env));
44
+
("cwd", `String t.cwd);
30
45
("capabilities", `Assoc [
31
46
("bounding", strings default_linux_caps);
32
47
("effective", strings default_linux_caps);
···
41
56
("root", `Assoc [
42
57
("path", `String root);
43
58
("readonly", `Bool false) ]);
44
-
("hostname", `String hostname);
59
+
("hostname", `String t.hostname);
45
60
("mounts", `List (
46
-
List.map Mount.to_json mounts
61
+
List.map Mount.to_json t.mounts
47
62
@ [
48
63
Mount.(to_json { ty = "proc"; src = "proc"; dst = "/proc";
49
64
options = [ "nosuid"; "noexec"; "nodev" ] });
···
69
84
dst = "/dev/mqueue";
70
85
options = [ "nosuid"; "noexec"; "nodev" ] });
71
86
]
72
-
@ (if network then
87
+
@ (if t.network then
73
88
[ Mount.(to_json { ty = "bind"; src = "/etc/resolv.conf";
74
89
dst = "/etc/resolv.conf";
75
90
options = [ "ro"; "rbind"; "rprivate" ] }) ]
···
77
92
("linux", `Assoc [
78
93
("namespaces", `List (
79
94
List.map (fun ns -> `Assoc [ ("type", `String ns) ])
80
-
((if network then [] else [ "network" ])
95
+
((if t.network then [] else [ "network" ])
81
96
@ [ "pid"; "ipc"; "uts"; "mount" ])));
82
97
("maskedPaths", strings [
83
98
"/proc/acpi"; "/proc/asound"; "/proc/kcore"; "/proc/keys";
···
102
117
]);
103
118
]
104
119
105
-
let write bundle_dir spec =
120
+
let write ~root bundle_dir t =
106
121
let path = Fpath.(bundle_dir / "config.json") in
107
122
try
108
-
Yojson.Safe.to_file (Fpath.to_string path) spec;
123
+
Yojson.Safe.to_file (Fpath.to_string path) (to_yojson ~root t);
109
124
Ok ()
110
125
with exn ->
111
126
Rresult.R.error_msgf "Oci_spec.write %a: %s"
+38
-28
day11/container/oci_spec.mli
+38
-28
day11/container/oci_spec.mli
···
6
6
rootfs, with what namespaces, capabilities, mounts, seccomp
7
7
filters, and so on.
8
8
9
-
This module generates that JSON. It is a pure function — no
10
-
filesystem side effects — so the spec can be inspected, tested,
11
-
or transformed before being written. {!write} is the convenience
12
-
that commits a spec to [config.json] inside a bundle directory.
9
+
{1 Spec templates}
10
+
11
+
A {!t} value is a {b spec template} — a fully-described container
12
+
parameterized only by the rootfs path. Every other field
13
+
(cwd, env, argv, mounts, namespaces, capabilities, …) is baked
14
+
in when the template is constructed via {!make}.
15
+
16
+
Templates exist because the rootfs path is typically only known
17
+
{e after} a host-side mount step (overlayfs, bind mount, chroot
18
+
setup, …). The caller knows what container they want well in
19
+
advance; the rootfs path is filled in last by the code that
20
+
physically performs the mount and then calls {!to_yojson} or
21
+
{!write}.
13
22
14
23
{1 Defaults}
15
24
···
36
45
{- If [~network:true]: a bind-mount of [/etc/resolv.conf] so
37
46
DNS works inside the container.}}
38
47
39
-
What varies per call is essentially: {e what to run, where, as
40
-
whom, and with which extra mounts}. *)
48
+
What varies per call is: what command to run, where, as whom,
49
+
and with which extra mounts. *)
50
+
51
+
type t
52
+
(** A spec template — a fully-described container missing only the
53
+
rootfs path. Construct with {!make}, instantiate with
54
+
{!to_yojson} or {!write}. *)
41
55
42
56
val make :
43
57
?terminal:bool ->
···
46
60
?env:(string * string) list ->
47
61
?mounts:Mount.t list ->
48
62
?network:bool ->
49
-
root:string ->
50
63
argv:string list ->
51
64
uid:int ->
52
65
gid:int ->
53
66
unit ->
54
-
Yojson.Safe.t
55
-
(** [make ~root ~argv ~uid ~gid ()] builds a complete OCI runtime
56
-
spec ready to be written as [config.json] and handed to
57
-
[runc run].
58
-
59
-
Required arguments identify what the container will actually
60
-
execute: the rootfs path on the host, the command to run, and
61
-
the user identity inside the container.
67
+
t
68
+
(** [make ~argv ~uid ~gid ()] builds a spec template. The rootfs
69
+
path is supplied later via {!to_yojson} or {!write}.
62
70
63
-
@param root Absolute host path of the container's rootfs
64
-
(typically the [target] of an {!Overlay.mount} call).
65
71
@param argv Command and arguments. First element is the
66
72
executable, the rest are passed to it unchanged.
67
73
@param uid User ID inside the container.
68
74
@param gid Group ID inside the container.
69
-
@param terminal Whether to allocate a controlling TTY. Default
70
-
[false] (build containers run non-interactively).
75
+
@param terminal Whether to allocate a controlling TTY.
76
+
Default [false].
71
77
@param cwd Working directory inside the container. Default ["/"].
72
78
@param hostname Hostname visible inside the container. Default
73
79
["container"].
74
-
@param env Environment variables as [(key, value)] pairs. Default
75
-
[[]]. They are serialized as [KEY=value] strings.
80
+
@param env Environment variables as [(key, value)] pairs.
81
+
Serialized as [KEY=value] strings. Default [[]].
76
82
@param mounts Extra bind mounts on top of the standard system
77
83
mounts (which are added automatically). Default [[]].
78
84
@param network If [true], the container joins the host network
79
85
namespace and gets [/etc/resolv.conf] bind-mounted. If [false]
80
86
(the default), the container is in its own network namespace
81
-
and has no connectivity.
82
-
@return A {!Yojson.Safe.t} [`Assoc] value. *)
87
+
and has no connectivity. *)
88
+
89
+
val to_yojson : root:string -> t -> Yojson.Safe.t
90
+
(** [to_yojson ~root t] instantiates the template with [root] as the
91
+
container's rootfs path and returns the JSON object that runc
92
+
expects in [config.json]. *)
83
93
84
94
val write :
95
+
root:string ->
85
96
Fpath.t ->
86
-
Yojson.Safe.t ->
97
+
t ->
87
98
(unit, [> Rresult.R.msg ]) result
88
-
(** [write bundle_dir spec] writes [spec] as [bundle_dir/config.json],
89
-
which is where {{!Runc.run} [runc]} expects to find it. Separate
90
-
from {!make} so that callers can inspect or transform the spec
91
-
in memory before committing it. *)
99
+
(** [write ~root bundle_dir t] instantiates [t] with [root] and
100
+
writes it as [bundle_dir/config.json], where {{!Runc.run}runc}
101
+
expects to find it. *)
+2
-2
day11/container/test/test_build_package.ml
+2
-2
day11/container/test/test_build_package.ml
···
70
70
("OPAMPRECISETRACKING", "1");
71
71
]
72
72
~network:true
73
-
~root:(Fpath.to_string merged)
74
73
~argv:[ "/usr/bin/env"; "bash"; "-c";
75
74
Printf.sprintf "opam install -y %s" pkg ]
76
75
~uid ~gid
77
76
()
78
77
in
79
-
Day11_container.Oci_spec.write temp_dir spec
78
+
Day11_container.Oci_spec.write
79
+
~root:(Fpath.to_string merged) temp_dir spec
80
80
|> ok_or_fail "write spec";
81
81
let container_id =
82
82
Printf.sprintf "day11-build-%s-%d" pkg (Unix.getpid ())
+17
-14
day11/container/test/test_container.ml
+17
-14
day11/container/test/test_container.ml
···
66
66
~hostname:"builder"
67
67
~env:[ ("PATH", "/usr/bin"); ("HOME", "/home/opam") ]
68
68
~network
69
-
~root:"/rootfs"
70
69
~argv:[ "sh"; "-c"; "echo hello" ]
71
70
~uid:1000 ~gid:1000
72
71
()
73
72
73
+
(* Helper to convert a spec to the JSON form used by the older tests
74
+
that inspected the JSON directly. *)
75
+
let spec_to_json spec = Oci_spec.to_yojson ~root:"/rootfs" spec
76
+
74
77
let test_oci_spec_basic () =
75
-
let spec = make_basic_spec () in
78
+
let spec = spec_to_json (make_basic_spec ()) in
76
79
(* Check ociVersion *)
77
80
Alcotest.(check bool) "has ociVersion"
78
81
true (json_member "ociVersion" spec <> `Null);
···
97
100
"builder" (spec |> json_member "hostname" |> json_to_string)
98
101
99
102
let test_oci_spec_env () =
100
-
let spec = make_basic_spec () in
103
+
let spec = spec_to_json (make_basic_spec ()) in
101
104
let process = json_member "process" spec in
102
105
let env = process |> json_member "env" |> json_to_list
103
106
|> List.map json_to_string in
···
107
110
true (List.mem "HOME=/home/opam" env)
108
111
109
112
let test_oci_spec_seccomp () =
110
-
let spec = make_basic_spec () in
113
+
let spec = spec_to_json (make_basic_spec ()) in
111
114
let linux = json_member "linux" spec in
112
115
let seccomp = json_member "seccomp" linux in
113
116
Alcotest.(check string) "default action"
···
127
130
(rule |> json_member "action" |> json_to_string)
128
131
129
132
let test_oci_spec_network_disabled () =
130
-
let spec = make_basic_spec ~network:false () in
133
+
let spec = spec_to_json (make_basic_spec ~network:false ()) in
131
134
let linux = json_member "linux" spec in
132
135
let namespaces = linux |> json_member "namespaces" |> json_to_list in
133
136
let ns_types = List.map (fun ns ->
···
142
145
false (List.mem "/etc/resolv.conf" mount_dsts)
143
146
144
147
let test_oci_spec_network_enabled () =
145
-
let spec = make_basic_spec ~network:true () in
148
+
let spec = spec_to_json (make_basic_spec ~network:true ()) in
146
149
let linux = json_member "linux" spec in
147
150
let namespaces = linux |> json_member "namespaces" |> json_to_list in
148
151
let ns_types = List.map (fun ns ->
···
159
162
160
163
let test_oci_spec_with_mounts () =
161
164
let user_mount = Mount.bind_ro ~src:"/host/repo" "/opam-repo" in
162
-
let spec =
165
+
let spec = spec_to_json (
163
166
Oci_spec.make
164
167
~hostname:"test" ~mounts:[ user_mount ]
165
-
~root:"/rootfs" ~argv:[ "true" ]
168
+
~argv:[ "true" ]
166
169
~uid:0 ~gid:0
167
-
()
170
+
())
168
171
in
169
172
let mounts = spec |> json_member "mounts" |> json_to_list in
170
173
let mount_dsts = List.map (fun m ->
···
177
180
true (List.mem "/proc" mount_dsts)
178
181
179
182
let test_oci_spec_capabilities () =
180
-
let spec = make_basic_spec () in
183
+
let spec = spec_to_json (make_basic_spec ()) in
181
184
let process = json_member "process" spec in
182
185
let caps = json_member "capabilities" process in
183
186
let bounding = caps |> json_member "bounding" |> json_to_list
···
188
191
true (List.mem "CAP_SYS_CHROOT" bounding)
189
192
190
193
let test_oci_spec_terminal () =
191
-
let spec =
194
+
let spec = spec_to_json (
192
195
Oci_spec.make
193
196
~terminal:true ~hostname:"debug" ~network:true
194
-
~root:"/rootfs" ~argv:[ "/bin/bash" ]
197
+
~argv:[ "/bin/bash" ]
195
198
~uid:1000 ~gid:1000
196
-
()
199
+
())
197
200
in
198
201
let process = json_member "process" spec in
199
202
Alcotest.(check bool) "terminal true"
···
203
206
204
207
let test_write_spec () = with_tmp_dir @@ fun dir ->
205
208
let spec = make_basic_spec () in
206
-
Oci_spec.write dir spec |> is_ok "write";
209
+
Oci_spec.write ~root:"/rootfs" dir spec |> is_ok "write";
207
210
let config_path = Fpath.(dir / "config.json") in
208
211
Alcotest.(check bool) "config.json exists"
209
212
true (Bos.OS.File.exists config_path |> Result.get_ok);
+6
-6
day11/container/test/test_integration.ml
+6
-6
day11/container/test/test_integration.ml
···
44
44
Oci_spec.make
45
45
~hostname:"test"
46
46
~env:[ ("PATH", "/bin") ]
47
-
~root:(Fpath.to_string rootfs)
48
47
~argv:[ "/bin/echo"; "hello from container" ]
49
48
~uid:0 ~gid:0
50
49
()
51
50
in
52
-
Oci_spec.write dir spec |> ok_or_fail "write_spec";
51
+
Oci_spec.write ~root:(Fpath.to_string rootfs) dir spec
52
+
|> ok_or_fail "write_spec";
53
53
(* Run it *)
54
54
let container_id = "day11-test-" ^ string_of_int (Unix.getpid ()) in
55
55
(* Clean up any stale container *)
···
99
99
Oci_spec.make
100
100
~hostname:"test"
101
101
~env:[ ("PATH", "/bin") ]
102
-
~root:(Fpath.to_string merged)
103
102
~argv:[ "/bin/cat"; "/etc/greeting" ]
104
103
~uid:0 ~gid:0
105
104
()
106
105
in
107
-
Oci_spec.write dir spec |> ok_or_fail "write_spec";
106
+
Oci_spec.write ~root:(Fpath.to_string merged) dir spec
107
+
|> ok_or_fail "write_spec";
108
108
let container_id = "day11-overlay-" ^ string_of_int (Unix.getpid ()) in
109
109
ignore (Runc.delete env container_id);
110
110
let run =
···
218
218
Oci_spec.make
219
219
~hostname:"test"
220
220
~env:[ ("PATH", "/bin") ]
221
-
~root:(Fpath.to_string merged)
222
221
~argv:[ "/bin/sh"; "-c"; script ]
223
222
~uid:0 ~gid:0
224
223
()
225
224
in
226
-
Oci_spec.write dir spec |> ok_or_fail "write_spec";
225
+
Oci_spec.write ~root:(Fpath.to_string merged) dir spec
226
+
|> ok_or_fail "write_spec";
227
227
let container_id =
228
228
Printf.sprintf "day11-hybrid-%d-%d" n_layers (Unix.getpid ()) in
229
229
ignore (Runc.delete env container_id);
+21
-3
day11/doc/generate.ml
+21
-3
day11/doc/generate.ml
···
49
49
ignore (Day11_exec.Sudo.rm_rf _env
50
50
Fpath.(upper / "home" / "opam" / "doc-tools"))
51
51
52
+
(** Pre-mount prep for an odoc doc container. The container has
53
+
bind mounts at [/home/opam/odoc-out] and [/home/opam/html] for
54
+
its output, and runc requires those mount points to exist
55
+
inside the merged rootfs. We mkdir them in the upper before
56
+
mounting and chown them to the build user. No opam switch-state
57
+
is needed — doc containers don't run [opam install]. *)
58
+
let doc_prep_upper env ~uid ~gid ~upper ~lowers:_ =
59
+
let mkdir path = Bos.OS.Dir.create ~path:true path |> ignore in
60
+
let odoc_out = Fpath.(upper / "home" / "opam" / "odoc-out") in
61
+
let html = Fpath.(upper / "home" / "opam" / "html") in
62
+
mkdir odoc_out; mkdir html;
63
+
ignore (Day11_exec.Sudo.run env
64
+
Bos.Cmd.(v "chown" % Printf.sprintf "%d:%d" uid gid
65
+
% Fpath.to_string odoc_out % Fpath.to_string html))
66
+
52
67
let odoc_bin = "/home/opam/doc-tools/bin/odoc"
53
68
let odoc_md_bin = "/home/opam/doc-tools/bin/odoc-md"
54
69
···
131
146
in
132
147
let result =
133
148
match Day11_build.Build_layer.build env benv
134
-
~mounts:(mounts @ store_mounts) ~skip_state_dump:true
149
+
~mounts:(mounts @ store_mounts) ~build_dirs:[]
150
+
~prep_upper:(doc_prep_upper env ~uid:benv.uid ~gid:benv.gid)
135
151
~on_extract
136
152
compile_node
137
153
~strategy:{ cmd; cleanup = doc_cleanup } () with
···
193
209
in
194
210
let result =
195
211
match Day11_build.Build_layer.build env benv
196
-
~mounts:(mounts @ store_mounts) ~skip_state_dump:true
212
+
~mounts:(mounts @ store_mounts) ~build_dirs:[]
213
+
~prep_upper:(doc_prep_upper env ~uid:benv.uid ~gid:benv.gid)
197
214
~on_extract
198
215
link_node
199
216
~strategy:{ cmd; cleanup = doc_cleanup } () with
···
253
270
in
254
271
let result =
255
272
match Day11_build.Build_layer.build env benv
256
-
~mounts:(mounts @ store_mounts) ~skip_state_dump:true
273
+
~mounts:(mounts @ store_mounts) ~build_dirs:[]
274
+
~prep_upper:(doc_prep_upper env ~uid:benv.uid ~gid:benv.gid)
257
275
~on_extract
258
276
doc_node
259
277
~strategy:{ cmd; cleanup = doc_cleanup } () with
+3
-2
day11/doc/test/test_generate_docs.ml
+3
-2
day11/doc/test/test_generate_docs.ml
···
96
96
(Day11_opam_layer.Build.dir ~os_dir) all_builds in
97
97
let benv = Day11_build.Types.make_build_env
98
98
~base ~os_dir ~uid:1000 ~gid:1000 () in
99
+
let spec = Day11_build.Build_layer.opam_build_spec
100
+
~cmd:voodoo_cmd ~mounts ~uid:1000 ~gid:1000 in
99
101
let run, upper, _timing =
100
-
Day11_build.Run_in_layers.run env benv ~build_dirs
101
-
~mounts voodoo_cmd
102
+
Day11_build.Run_in_layers.run env benv ~build_dirs spec
102
103
|> ok_or_fail "run voodoo"
103
104
in
104
105
Fun.protect