forked from
anil.recoil.org/monopam-myspace
My aggregated monorepo of OCaml code, automaintained
day11/layer: split into layer / opam_layer / doc_layer
Cleans up the layer library API after a series of incremental
refactors. The headline change: data layers are now split by domain
into three sibling libraries.
- day11_layer is now strictly generic. No opam-format dep, no
recursive build types, no opam_format anywhere. Just enough to
enumerate, hash, stack, mount-plan, and metadata-roundtrip layer
directories on disk.
- day11_opam_layer holds opam-package concerns: the recursive
Build.t / Tool.t types used by the planner and executor, the
build.json sidecar (Build_meta), Installed_files, Opam_repo,
Opamh.
- day11_doc_layer is a tiny new library holding only the doc.json
sidecar (Doc_meta with Compile/Link/Doc_all phase). Independent of
day11_opam_layer — it depends only on day11_layer + yojson, so a
doc-browsing tool could link it without pulling in opam-format.
Other changes that came along the way:
- Removed the kind field from layer.json. The kind of a layer is
now implicit in which sidecar files exist alongside layer.json
(build.json -> opam build, doc.json -> odoc layer, ...). This
removes a whole class of "the field in the JSON disagrees with
reality" bug.
- Sidecars must be valid JSON (documented in Layer_meta.mli and the
README). The library doesn't enforce this, but it lets generic
tooling display sidecar contents without depending on any domain
library.
- The day11_layer Layer_* prefixes are gone:
Layer_meta -> Meta
Layer_dir -> Dir
Layer_symlinks -> Symlinks
Layer_type.base -> Base.t
- Layer_meta is now a stripped-down record with only generic fields
(exit_status, parent_hashes, uid, gid, base_hash, disk_usage,
timing, created_at, failed_dep). Old layers in the cache still
load thanks to ppx_deriving_yojson { strict = false }.
- Build_layer.build no longer takes a kind parameter. It only writes
the generic layer.json and invokes an on_extract callback so the
caller can write its own sidecar (build.json or doc.json).
- Run_in_layers.run now takes a Types.build_env directly instead of
separate ~base ~uid ~gid arguments.
- day11-layer-cli is purely generic. Reads layer.json + lists every
other file in the layer directory. The show command pretty-prints
any sidecar as opaque JSON via Yojson directly — it doesn't link
any domain library, doesn't know what build.json or doc.json mean.
The cat subcommand was dropped; show does the job.
- Container library: Overlay.mount docstring fixed (was claiming
the wrong lower-ordering convention); Runc.write_spec moved to
Oci_spec.write; Oci_spec.make has optional defaults for the
obvious fields; mli files rewritten with odoc-style structure.
Test status: 12 suites, 196 tests, all green. Includes 16 generic
day11_layer tests, 8 day11_opam_layer tests, 3 day11_doc_layer
tests, 12 day11_container unit tests, plus the existing build/doc/
batch suites.
End-to-end smoke build of logs.0.10.0 verified:
- layer.json contains only generic fields (no kind, no package, no
opam stuff)
- build.json sidecar contains opam-specific fields (package, deps,
installed_libs, installed_docs, patches)
- The layer CLI reads and displays both correctly without depending
on any opam-aware library.
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
+2000
-1365
+10
-8
day11/batch/rerun.ml
+10
-8
day11/batch/rerun.ml
···
1
-
open Day11_layer.Layer_type
1
+
module Build = Day11_opam_layer.Build
2
+
module Tool = Day11_opam_layer.Tool
3
+
type build = Build.t
2
4
3
5
let load_exit_status layer_json =
4
-
match Day11_layer.Layer_meta.load_build layer_json with
6
+
match Day11_layer.Meta.load layer_json with
5
7
| Ok { exit_status; _ } -> Some exit_status
6
8
| Error _ -> None
7
9
8
-
let build_env_of_meta ~os_dir ~cache_dir (meta : Day11_layer.Layer_meta.build_meta) =
10
+
let build_env_of_meta ~os_dir ~cache_dir (meta : Day11_layer.Meta.t) =
9
11
let base_dir = Fpath.(cache_dir / "base") in
10
-
let base : base = {
12
+
let base : Day11_layer.Base.t = {
11
13
hash = meta.base_hash;
12
14
dir = base_dir;
13
15
image = ""; (* not needed for rebuild *)
···
16
18
~uid:meta.uid ~gid:meta.gid ()
17
19
18
20
let rerun env ~os_dir ~cache_dir node =
19
-
let layer_dir = build_dir ~os_dir node in
21
+
let layer_dir = Build.dir ~os_dir node in
20
22
let layer_json = Fpath.(layer_dir / "layer.json") in
21
-
match Day11_layer.Layer_meta.load_build layer_json with
23
+
match Day11_layer.Meta.load layer_json with
22
24
| Error (`Msg e) ->
23
25
Day11_build.Types.Failure e
24
26
| Ok { exit_status = 0; _ } ->
···
38
40
let cascade env ~os_dir ~cache_dir nodes =
39
41
let rerun_count = ref 0 in
40
42
List.iter (fun (node : build) ->
41
-
let layer_json = Fpath.(build_dir ~os_dir node / "layer.json") in
43
+
let layer_json = Fpath.(Build.dir ~os_dir node / "layer.json") in
42
44
match load_exit_status layer_json with
43
45
| Some (-1) ->
44
46
let all_deps_ok = List.for_all (fun (dep : build) ->
45
-
let dep_json = Fpath.(build_dir ~os_dir dep / "layer.json") in
47
+
let dep_json = Fpath.(Build.dir ~os_dir dep / "layer.json") in
46
48
load_exit_status dep_json = Some 0
47
49
) node.deps in
48
50
if all_deps_ok then begin
+2
-2
day11/batch/rerun.mli
+2
-2
day11/batch/rerun.mli
···
8
8
Eio_unix.Stdenv.base ->
9
9
os_dir:Fpath.t ->
10
10
cache_dir:Fpath.t ->
11
-
Day11_layer.Layer_type.build ->
11
+
Day11_opam_layer.Build.t ->
12
12
Day11_build.Types.build_result
13
13
(** [rerun env ~os_dir ~cache_dir node] rebuilds a failed layer.
14
14
Reads uid/gid/base_hash from the layer's [layer.json] and
···
18
18
Eio_unix.Stdenv.base ->
19
19
os_dir:Fpath.t ->
20
20
cache_dir:Fpath.t ->
21
-
Day11_layer.Layer_type.build list ->
21
+
Day11_opam_layer.Build.t list ->
22
22
int
23
23
(** [cascade env ~os_dir ~cache_dir nodes] scans [nodes] for
24
24
dependency failures where the dependency has since succeeded,
+3
-3
day11/batch/targets.ml
+3
-3
day11/batch/targets.ml
···
6
6
7
7
let find_latest_versions git_packages =
8
8
let all_names = Day11_opam.Git_packages.all_names git_packages in
9
-
let compiler_names = Day11_layer.Opamh.compiler_packages in
9
+
let compiler_names = Day11_opam_layer.Opamh.compiler_packages in
10
10
let all_names = List.filter (fun name ->
11
11
not (List.mem name compiler_names)
12
12
) all_names in
···
26
26
27
27
let find_all_versions git_packages =
28
28
let all_names = Day11_opam.Git_packages.all_names git_packages in
29
-
let compiler_names = Day11_layer.Opamh.compiler_packages in
29
+
let compiler_names = Day11_opam_layer.Opamh.compiler_packages in
30
30
let all_names = List.filter (fun name ->
31
31
not (List.mem name compiler_names)
32
32
) all_names in
···
67
67
match target with
68
68
| None when small && all_versions ->
69
69
Printf.printf "Finding all versions of small universe...\n%!";
70
-
let compiler_names = Day11_layer.Opamh.compiler_packages in
70
+
let compiler_names = Day11_opam_layer.Opamh.compiler_packages in
71
71
let names = List.filter_map (fun name ->
72
72
let n = OpamPackage.Name.of_string name in
73
73
if List.mem n compiler_names then None else Some n
+4
-4
day11/batch/test/test_batch.ml
+4
-4
day11/batch/test/test_batch.ml
···
97
97
98
98
let test_dag_executor_basic () = with_eio @@ fun env ->
99
99
let completed = ref [] in
100
-
let node_c : Day11_layer.Layer_type.build =
100
+
let node_c : Day11_opam_layer.Build.t =
101
101
{ hash = "build-c"; pkg = pkg "c.1"; deps = []; universe = Day11_graph.Universe.dummy } in
102
-
let node_b : Day11_layer.Layer_type.build =
102
+
let node_b : Day11_opam_layer.Build.t =
103
103
{ hash = "build-b"; pkg = pkg "b.1"; deps = [node_c]; universe = Day11_graph.Universe.dummy } in
104
104
let nodes = [ node_c; node_b ] in
105
105
Dag_executor.execute env ~np:2
···
115
115
116
116
let test_dag_executor_failure_cascade () = with_eio @@ fun env ->
117
117
let cascaded = ref [] in
118
-
let node_c : Day11_layer.Layer_type.build =
118
+
let node_c : Day11_opam_layer.Build.t =
119
119
{ hash = "build-c"; pkg = pkg "c.1"; deps = []; universe = Day11_graph.Universe.dummy } in
120
-
let node_b : Day11_layer.Layer_type.build =
120
+
let node_b : Day11_opam_layer.Build.t =
121
121
{ hash = "build-b"; pkg = pkg "b.1"; deps = [node_c]; universe = Day11_graph.Universe.dummy } in
122
122
let nodes = [ node_c; node_b ] in
123
123
Dag_executor.execute env ~np:2
+2
-2
day11/batch/test/test_cmdliner_all.ml
+2
-2
day11/batch/test/test_cmdliner_all.ml
···
107
107
Printf.printf " %d total nodes\n%!" (List.length nodes);
108
108
(* Check that cmdliner nodes exist in the DAG *)
109
109
let cmdliner_nodes =
110
-
List.filter (fun (n : Day11_layer.Layer_type.build) ->
110
+
List.filter (fun (n : Day11_opam_layer.Build.t) ->
111
111
String.equal "cmdliner"
112
112
(OpamPackage.Name.to_string (OpamPackage.name n.pkg))
113
113
) nodes
114
114
in
115
115
Printf.printf " cmdliner versions in DAG: %s\n%!"
116
-
(String.concat ", " (List.map (fun (n : Day11_layer.Layer_type.build) ->
116
+
(String.concat ", " (List.map (fun (n : Day11_opam_layer.Build.t) ->
117
117
OpamPackage.to_string n.pkg) cmdliner_nodes));
118
118
Alcotest.(check bool) "some cmdliner in DAG" true
119
119
(List.length cmdliner_nodes > 0);
+1
-1
day11/benchmark/benchmark.ml
+1
-1
day11/benchmark/benchmark.ml
···
96
96
(* Warm cache: build astring (should be instant) *)
97
97
let astring_hash = Day11_build.Hash_cache.layer_hash cache
98
98
~base_hash:base.hash [ OpamPackage.of_string "astring.0.8.5" ] in
99
-
let astring_node : Day11_layer.Layer_type.build =
99
+
let astring_node : Day11_opam_layer.Build.t =
100
100
{ hash = astring_hash;
101
101
pkg = OpamPackage.of_string "astring.0.8.5";
102
102
deps = []; universe = Day11_graph.Universe.dummy } in
+3
-3
day11/benchmark/benchmark_builds.ml
+3
-3
day11/benchmark/benchmark_builds.ml
···
81
81
Printf.printf "\n--- Cache hit timing ---\n%!";
82
82
List.iter (fun pkg_str ->
83
83
let pkg = OpamPackage.of_string pkg_str in
84
-
match List.find_opt (fun (n : Day11_layer.Layer_type.build) ->
84
+
match List.find_opt (fun (n : Day11_opam_layer.Build.t) ->
85
85
OpamPackage.equal n.pkg pkg) nodes with
86
86
| Some node ->
87
87
ignore (time (Printf.sprintf "Build %s (cache hit)" pkg_str) (fun () ->
···
92
92
Printf.printf "\n--- Cold rebuild timing ---\n%!";
93
93
List.iter (fun pkg_str ->
94
94
let pkg = OpamPackage.of_string pkg_str in
95
-
match List.find_opt (fun (n : Day11_layer.Layer_type.build) ->
95
+
match List.find_opt (fun (n : Day11_opam_layer.Build.t) ->
96
96
OpamPackage.equal n.pkg pkg) nodes with
97
97
| Some node ->
98
-
let layer_dir = Day11_layer.Layer_type.build_dir ~os_dir node in
98
+
let layer_dir = Day11_opam_layer.Build.dir ~os_dir node in
99
99
(* Delete just this layer to force rebuild *)
100
100
ignore (Day11_exec.Sudo.rm_rf env layer_dir);
101
101
ignore (time (Printf.sprintf "Build %s (cold)" pkg_str) (fun () ->
+7
-7
day11/benchmark/benchmark_docs.ml
+7
-7
day11/benchmark/benchmark_docs.ml
···
62
62
(fun node ->
63
63
match Day11_build.Build_layer.build env benv node () with
64
64
| Day11_build.Types.Success _ -> true | _ -> false);
65
-
List.find (fun (n : Day11_layer.Layer_type.build) ->
65
+
List.find (fun (n : Day11_opam_layer.Build.t) ->
66
66
OpamPackage.equal n.pkg astring_pkg) astring_nodes) in
67
-
let pkg_dir = Day11_layer.Layer_type.build_dir ~os_dir astring_build in
67
+
let pkg_dir = Day11_opam_layer.Build.dir ~os_dir astring_build in
68
68
Printf.printf " astring: %d real deps\n%!"
69
69
(List.length astring_build.deps);
70
70
(* Prep *)
71
-
let installed_libs = Day11_layer.Installed_files.scan_libs ~layer_dir:pkg_dir in
72
-
let installed_docs = Day11_layer.Installed_files.scan_docs ~layer_dir:pkg_dir in
71
+
let installed_libs = Day11_opam_layer.Installed_files.scan_libs ~layer_dir:pkg_dir in
72
+
let installed_docs = Day11_opam_layer.Installed_files.scan_docs ~layer_dir:pkg_dir in
73
73
let universe = Day11_doc.Command.compute_universe_hash
74
-
(List.map (fun (b : Day11_layer.Layer_type.build) -> b.hash)
74
+
(List.map (fun (b : Day11_opam_layer.Build.t) -> b.hash)
75
75
astring_nodes) in
76
76
Printf.printf "\n--- Single-phase (--actions all) ---\n%!";
77
77
(* Delete existing doc layer *)
···
94
94
--actions all -j $(nproc) -v --blessed \
95
95
--odoc %s --odoc-md %s"
96
96
voodoo_bin "astring" odoc_bin odoc_md_bin in
97
-
let doc_node : Day11_layer.Layer_type.build =
97
+
let doc_node : Day11_opam_layer.Build.t =
98
98
{ hash = doc_hash; pkg = astring_pkg;
99
99
deps = astring_build.deps @ [ astring_build ]; universe = Day11_graph.Universe.dummy } in
100
100
let html_count = time "Doc gen astring (cold, single phase)" (fun () ->
101
101
match Day11_build.Build_layer.build env benv ~mounts:all_mounts
102
102
doc_node ~strategy:{ cmd; cleanup = fun _ _ -> () } () with
103
103
| Day11_build.Types.Success bl ->
104
-
let dd = Day11_layer.Layer_type.build_dir ~os_dir bl in
104
+
let dd = Day11_opam_layer.Build.dir ~os_dir bl in
105
105
let find_run = Day11_exec.Run.run env
106
106
Bos.Cmd.(v "find" % Fpath.to_string Fpath.(dd / "fs")
107
107
% "-name" % "*.html" % "-type" % "f") None in
+1
-1
day11/benchmark/trial_run.ml
+1
-1
day11/benchmark/trial_run.ml
···
240
240
Day11_build.Dag_executor.execute env ~np:4
241
241
~on_complete:(fun ~total:_ ~completed:_ ~failed:_ node success ->
242
242
if success then begin
243
-
let dir = Day11_layer.Layer_type.build_dir ~os_dir node in
243
+
let dir = Day11_opam_layer.Build.dir ~os_dir node in
244
244
let layer_json = Fpath.(dir / "layer.json") in
245
245
let is_cached = match Bos.OS.File.read layer_json with
246
246
| Ok _ -> true | Error _ -> false in
+39
-19
day11/bin/cmd_batch.ml
+39
-19
day11/bin/cmd_batch.ml
···
1
1
(** batch command: solve, build, and optionally generate docs *)
2
2
3
3
open Cmdliner
4
-
open Day11_layer.Layer_type
4
+
module Build = Day11_opam_layer.Build
5
+
module Tool = Day11_opam_layer.Tool
6
+
type build = Build.t
7
+
type tool = Tool.t
5
8
6
9
7
10
···
200
203
if rebuild_failed then begin
201
204
let root_deleted = ref 0 in
202
205
let cascade_deleted = ref 0 in
203
-
List.iter (fun (node : Day11_layer.Layer_type.build) ->
204
-
let dir = Day11_layer.Layer_type.build_dir ~os_dir node in
206
+
List.iter (fun (node : Day11_opam_layer.Build.t) ->
207
+
let dir = Day11_opam_layer.Build.dir ~os_dir node in
205
208
let layer_json = Fpath.(dir / "layer.json") in
206
209
if Bos.OS.File.exists layer_json |> Result.get_ok then
207
-
match Day11_layer.Layer_meta.load_build layer_json with
210
+
match Day11_layer.Meta.load layer_json with
208
211
| Ok { exit_status; failed_dep; _ } when exit_status <> 0 ->
209
212
ignore (Bos.OS.Path.delete ~recurse:true dir);
210
213
if failed_dep = None then incr root_deleted
···
216
219
!root_deleted !cascade_deleted
217
220
end;
218
221
(* Check which layers already exist *)
219
-
let n_cached = List.length (List.filter (fun (node : Day11_layer.Layer_type.build) ->
220
-
let dir = Day11_layer.Layer_type.build_dir ~os_dir node in
222
+
let n_cached = List.length (List.filter (fun (node : Day11_opam_layer.Build.t) ->
223
+
let dir = Day11_opam_layer.Build.dir ~os_dir node in
221
224
Bos.OS.File.exists Fpath.(dir / "layer.json") |> Result.get_ok
222
225
) nodes) in
223
226
let n_need_build = List.length nodes - n_cached in
···
227
230
if dry_run then begin
228
231
if n_need_build > 0 then begin
229
232
Printf.printf "\nLayers to build:\n";
230
-
List.iter (fun (node : Day11_layer.Layer_type.build) ->
231
-
let dir = Day11_layer.Layer_type.build_dir ~os_dir node in
233
+
List.iter (fun (node : Day11_opam_layer.Build.t) ->
234
+
let dir = Day11_opam_layer.Build.dir ~os_dir node in
232
235
if not (Bos.OS.File.exists Fpath.(dir / "layer.json")
233
236
|> Result.get_ok) then
234
237
Printf.printf " %s (%d deps)\n"
···
302
305
Printf.sprintf "echo 'fake-build %s'" pkg_str;
303
306
cleanup = Day11_build.Build_layer.opam_build_cleanup }
304
307
in
305
-
let build_one node =
308
+
let build_one (node : Day11_opam_layer.Build.t) =
306
309
let strategy =
307
310
if fake_build then Some (fake_strategy node.pkg)
308
311
else None
309
312
in
313
+
let pkg_str = OpamPackage.to_string node.pkg in
314
+
let on_extract ~layer_dir ~success:_ =
315
+
let installed_libs =
316
+
Day11_opam_layer.Installed_files.scan_libs ~layer_dir in
317
+
let installed_docs =
318
+
Day11_opam_layer.Installed_files.scan_docs ~layer_dir in
319
+
let bm : Day11_opam_layer.Build_meta.t = {
320
+
package = pkg_str;
321
+
deps = List.map (fun (d : Day11_opam_layer.Build.t) ->
322
+
OpamPackage.to_string d.pkg) node.deps;
323
+
installed_libs;
324
+
installed_docs;
325
+
patches = (match patches with
326
+
| Some p -> Day11_build.Patches.patch_filenames p node.pkg
327
+
| None -> []);
328
+
} in
329
+
ignore (Day11_opam_layer.Build_meta.save layer_dir bm)
330
+
in
310
331
match Day11_build.Build_layer.build env benv ?patches
311
-
~mounts:base_mounts node ?strategy () with
332
+
~mounts:base_mounts ~on_extract node ?strategy () with
312
333
| Day11_build.Types.Success _ ->
313
-
let pkg_str = OpamPackage.to_string node.pkg in
314
-
let layer_name = Day11_layer.Layer_type.build_dir_name node in
315
-
ignore (Day11_layer.Package_symlinks.ensure_layer_symlink
316
-
~packages_dir ~pkg_str ~layer_name);
334
+
let layer_name = Day11_opam_layer.Build.dir_name node in
335
+
ignore (Day11_layer.Symlinks.ensure
336
+
~packages_dir ~id:pkg_str ~layer_name);
317
337
true
318
338
| _ -> false
319
339
in
···
329
349
else begin
330
350
(* Build only — no docs *)
331
351
let is_cached node =
332
-
let layer_dir = Day11_layer.Layer_type.build_dir ~os_dir node in
352
+
let layer_dir = Day11_opam_layer.Build.dir ~os_dir node in
333
353
let cached =
334
354
Bos.OS.File.exists Fpath.(layer_dir / "layer.json")
335
355
|> Result.get_ok
···
341
361
~on_complete:(fun ~total ~completed ~failed node success ->
342
362
let status = if success then "ok" else "fail" in
343
363
let layer = Fpath.to_string
344
-
(Day11_layer.Layer_type.build_dir ~os_dir node) in
364
+
(Day11_opam_layer.Build.dir ~os_dir node) in
345
365
Day11_lib.Run_log.log_build_result run_log
346
366
~pkg:(OpamPackage.to_string node.pkg)
347
367
~hash:node.hash ~status ~failed_dep:None
···
374
394
let n_ok = ref 0 in
375
395
let n_fail = ref 0 in
376
396
let n_cascade = ref 0 in
377
-
List.iter (fun (node : Day11_layer.Layer_type.build) ->
378
-
let dir = Day11_layer.Layer_type.build_dir ~os_dir node in
379
-
match Day11_layer.Layer_meta.load_build Fpath.(dir / "layer.json") with
397
+
List.iter (fun (node : Day11_opam_layer.Build.t) ->
398
+
let dir = Day11_opam_layer.Build.dir ~os_dir node in
399
+
match Day11_layer.Meta.load Fpath.(dir / "layer.json") with
380
400
| Ok meta ->
381
401
if meta.exit_status = 0 then incr n_ok
382
402
else if meta.exit_status = -1 then incr n_cascade
+2
-2
day11/bin/cmd_debug.ml
+2
-2
day11/bin/cmd_debug.ml
···
7
7
let os_dir = Common.fpath os_dir in
8
8
(* Resolve target: hash or package name *)
9
9
let node =
10
-
match Day11_layer.Layer_meta.load_build_tree ~os_dir target with
10
+
match Day11_opam_layer.Build_meta.load_tree ~os_dir target with
11
11
| Ok n -> n
12
12
| Error _ ->
13
13
(* Try as package name — look up from history *)
···
19
19
match failure with
20
20
| Some e ->
21
21
Printf.printf "Using %s\n%!" e.build_hash;
22
-
(match Day11_layer.Layer_meta.load_build_tree ~os_dir e.build_hash with
22
+
(match Day11_opam_layer.Build_meta.load_tree ~os_dir e.build_hash with
23
23
| Ok n -> n
24
24
| Error (`Msg e) ->
25
25
Printf.eprintf "Cannot load %s: %s\n" target e;
+1
-1
day11/bin/cmd_query.ml
+1
-1
day11/bin/cmd_query.ml
···
14
14
List.iter (fun (name, _target) ->
15
15
let layer_dir = Fpath.(os_dir / name) in
16
16
let layer_json = Fpath.(layer_dir / "layer.json") in
17
-
match Day11_layer.Layer_meta.load_build layer_json with
17
+
match Day11_layer.Meta.load layer_json with
18
18
| Ok meta ->
19
19
let status = if meta.exit_status = 0 then "ok"
20
20
else if meta.failed_dep <> None then "cascade"
+2
-2
day11/bin/cmd_rerun.ml
+2
-2
day11/bin/cmd_rerun.ml
···
5
5
let run os_dir layer_hash =
6
6
Common.with_eio @@ fun env ->
7
7
let os_dir = Common.fpath os_dir in
8
-
match Day11_layer.Layer_meta.load_build_tree ~os_dir layer_hash with
8
+
match Day11_opam_layer.Build_meta.load_tree ~os_dir layer_hash with
9
9
| Error (`Msg e) ->
10
10
Printf.eprintf "Cannot load layer %s: %s\n" layer_hash e;
11
11
1
···
13
13
let cache_dir = Fpath.parent os_dir in
14
14
Printf.printf "Rerunning %s (%s)...\n%!"
15
15
(OpamPackage.to_string node.pkg)
16
-
(Day11_layer.Layer_type.build_dir_name node);
16
+
(Day11_opam_layer.Build.dir_name node);
17
17
match Day11_batch.Rerun.rerun env ~os_dir ~cache_dir node with
18
18
| Day11_build.Types.Success _ ->
19
19
Printf.printf "Success\n"; 0
+1
-1
day11/build/base.ml
+1
-1
day11/build/base.ml
···
7
7
let image = Printf.sprintf "%s:%s" os_distribution os_version in
8
8
hash ~image
9
9
10
-
let make_base_layer ~image ~base_dir : Day11_layer.Layer_type.base =
10
+
let make_base_layer ~image ~base_dir : Day11_layer.Base.t =
11
11
{ hash = hash ~image; dir = base_dir; image }
12
12
13
13
let ensure env ~cache_dir ~image =
+3
-3
day11/build/base.mli
+3
-3
day11/build/base.mli
···
4
4
Eio_unix.Stdenv.base ->
5
5
cache_dir:Fpath.t ->
6
6
image:string ->
7
-
(Day11_layer.Layer_type.base, [> Rresult.R.msg ]) result
7
+
(Day11_layer.Base.t, [> Rresult.R.msg ]) result
8
8
9
9
val build :
10
10
Eio_unix.Stdenv.base ->
···
16
16
uid:int ->
17
17
gid:int ->
18
18
unit ->
19
-
(Day11_layer.Layer_type.base, [> Rresult.R.msg ]) result
19
+
(Day11_layer.Base.t, [> Rresult.R.msg ]) result
20
20
21
21
val build_opam_build :
22
22
Eio_unix.Stdenv.base ->
···
39
39
val load_cached :
40
40
cache_dir:Fpath.t ->
41
41
os_distribution:string -> os_version:string ->
42
-
Day11_layer.Layer_type.base option
42
+
Day11_layer.Base.t option
+35
-53
day11/build/build_layer.ml
+35
-53
day11/build/build_layer.ml
···
1
1
let src = Logs.Src.create "day11.build.build_layer" ~doc:"Package build"
2
2
module Log = (val Logs.src_log src)
3
3
4
-
open Day11_layer.Layer_type
4
+
module Build = Day11_opam_layer.Build
5
5
6
6
let mkdir path =
7
7
Bos.OS.Dir.create ~path:true path |> ignore
···
34
34
cleanup = opam_build_cleanup }
35
35
36
36
(** Read the build result from an existing layer.json. *)
37
-
let result_of_layer_json layer_json (node : build) =
38
-
match Day11_layer.Layer_meta.load_build layer_json with
37
+
let result_of_layer_json layer_json (node : Build.t) =
38
+
match Day11_layer.Meta.load layer_json with
39
39
| Ok { exit_status = 0; _ } -> Types.Success node
40
-
| _ -> Types.Failure (build_dir_name node)
40
+
| _ -> Types.Failure (Build.dir_name node)
41
41
42
-
(** Extract the build result: move upper to layer, scan files, write metadata. *)
43
-
let extract_layer env ~layer_dir ~layer_json ~upper ~pkg_str ~kind
44
-
~(node : build) ~packages_dir ~(benv : Types.build_env)
45
-
?patches ~timing (run : Day11_exec.Run.t) =
46
-
let layer_name = build_dir_name node in
42
+
(** Extract the build result: move upper to layer, write generic
43
+
layer.json, then call [on_extract] so the caller can write any
44
+
domain-specific sidecar files. *)
45
+
let extract_layer env ~layer_dir ~layer_json ~upper ~pkg_str
46
+
~(node : Build.t) ~(benv : Types.build_env)
47
+
~timing ~on_extract (run : Day11_exec.Run.t) =
47
48
let exit_code = match run.status with
48
49
| `Exited n -> n
49
50
| `Signaled n -> 128 + n
···
56
57
let _ = Day11_exec.Sudo.run env
57
58
Bos.Cmd.(v "mv" % Fpath.to_string upper
58
59
% Fpath.to_string Fpath.(layer_dir / "fs")) in
59
-
let installed_libs =
60
-
Day11_layer.Installed_files.scan_libs ~layer_dir in
61
-
let installed_docs =
62
-
Day11_layer.Installed_files.scan_docs ~layer_dir in
63
60
let dep_hashes =
64
-
List.map (fun (d : build) -> d.hash) node.deps in
61
+
List.map (fun (d : Build.t) -> d.hash) node.deps in
65
62
let disk_usage = match Day11_exec.Util.dir_size layer_dir with
66
63
| Ok size -> size
67
64
| Error _ -> 0
68
65
in
69
-
let patch_names = match patches with
70
-
| Some p -> Patches.patch_filenames p node.pkg
71
-
| None -> []
72
-
in
73
-
let meta : Day11_layer.Layer_meta.build_meta = {
74
-
package = pkg_str;
75
-
kind;
66
+
let meta : Day11_layer.Meta.t = {
76
67
exit_status = exit_code;
77
-
deps = List.map (fun (d : build) -> OpamPackage.to_string d.pkg) node.deps;
78
-
hashes = dep_hashes;
68
+
parent_hashes = dep_hashes;
79
69
uid = benv.uid; gid = benv.gid;
80
70
base_hash = benv.base.hash;
81
-
installed_libs; installed_docs;
82
-
patches = patch_names; failed_dep = None;
83
71
disk_usage;
84
72
timing;
85
73
created_at = "";
74
+
failed_dep = None;
86
75
} in
87
-
let _ = Day11_layer.Layer_meta.save_build layer_json meta in
88
-
let _ = Day11_layer.Package_symlinks.ensure_layer_symlink
89
-
~packages_dir ~pkg_str ~layer_name in
76
+
let _ = Day11_layer.Meta.save layer_json meta in
77
+
on_extract ~layer_dir ~success:(exit_code = 0);
90
78
exit_code
91
79
92
80
(** Main entry point. *)
93
81
let build env (benv : Types.build_env)
94
82
?(opam_repositories = []) ?(mounts = [])
95
83
?patches ?(skip_state_dump = false)
96
-
?(kind = Day11_layer.Layer_meta.Build)
97
-
(node : build)
84
+
?(on_extract = fun ~layer_dir:_ ~success:_ -> ())
85
+
(node : Build.t)
98
86
?strategy () =
99
-
let base = benv.base in
100
87
let os_dir = benv.os_dir in
101
-
let packages_dir = Types.packages_dir benv in
102
-
let uid = benv.uid in
103
-
let gid = benv.gid in
104
88
let pkg_str = OpamPackage.to_string node.pkg in
105
-
let layer_name = build_dir_name node in
89
+
let layer_name = Build.dir_name node in
106
90
let strategy = match strategy with
107
91
| Some s -> s
108
92
| None -> opam_build_strategy ?patches node.pkg
109
93
in
110
-
let layer_dir = build_dir ~os_dir node in
94
+
let layer_dir = Build.dir ~os_dir node in
111
95
let layer_json = Fpath.(layer_dir / "layer.json") in
112
96
if Bos.OS.File.exists layer_json |> Result.get_ok then begin
113
97
Log.info (fun m -> m "Cache hit: %s (%s)" pkg_str layer_name);
···
116
100
end else begin
117
101
Log.info (fun m -> m "Building %s (%s)" pkg_str layer_name);
118
102
let lock_file = Fpath.(os_dir / (layer_name ^ ".lock")) in
119
-
(* Collect transitive dep dirs for overlay stacking.
120
-
Doc containers (skip_state_dump=true) don't need build deps
121
-
in the overlay — they access everything via bind mounts. *)
122
103
let dep_dirs =
123
104
if skip_state_dump then []
124
105
else begin
125
-
let rec collect_deps (seen : (string, unit) Hashtbl.t) (b : build) =
106
+
let rec collect_deps (seen : (string, unit) Hashtbl.t) (b : Build.t) =
126
107
if not (Hashtbl.mem seen b.hash) then begin
127
108
Hashtbl.replace seen b.hash ();
128
109
List.iter (collect_deps seen) b.deps
···
131
112
let seen = Hashtbl.create 16 in
132
113
List.iter (collect_deps seen) node.deps;
133
114
Hashtbl.fold (fun hash () acc ->
134
-
Fpath.(os_dir / ("build-" ^ String.sub hash 0 12)) :: acc
115
+
Day11_layer.Dir.path ~os_dir hash :: acc
135
116
) seen []
136
117
end
137
118
in
···
144
125
if opam_repositories = [] then []
145
126
else
146
127
let temp = Bos.OS.Dir.tmp "day11_repo_%s" |> Result.get_ok in
147
-
match Day11_layer.Opam_repo.create temp with
128
+
match Day11_opam_layer.Opam_repo.create temp with
148
129
| Ok repo_dir ->
149
-
let _ = Day11_layer.Opam_repo.populate ~opam_repo:repo_dir
130
+
let _ = Day11_opam_layer.Opam_repo.populate ~opam_repo:repo_dir
150
131
~opam_repositories [ node.pkg ] in
151
132
[ Day11_container.Mount.bind_ro
152
133
~src:(Fpath.to_string repo_dir)
···
163
144
| _ -> []
164
145
in
165
146
let all_mounts = repo_mounts @ patch_mounts @ mounts in
166
-
match Run_in_layers.run env ~base ~build_dirs:dep_dirs ~uid ~gid
147
+
match Run_in_layers.run env benv ~build_dirs:dep_dirs
167
148
~mounts:all_mounts ~skip_state_dump strategy.cmd with
168
149
| Ok (run, upper, timing) ->
169
150
strategy.cleanup env upper;
170
151
let _exit_code =
171
-
extract_layer env ~layer_dir ~layer_json ~upper ~kind
172
-
~pkg_str ~node ~packages_dir ~benv ?patches
173
-
~timing run in
152
+
extract_layer env ~layer_dir ~layer_json ~upper
153
+
~pkg_str ~node ~benv
154
+
~timing ~on_extract run in
174
155
ignore (Day11_exec.Sudo.rm_rf env (Fpath.parent upper));
175
156
Ok ()
176
157
| Error (`Msg e) ->
177
158
Log.err (fun m -> m "Build %s failed: %s" pkg_str e);
178
159
Printf.eprintf "BUILD ERROR %s: %s\n%!" pkg_str e;
179
-
let fail_meta : Day11_layer.Layer_meta.build_meta = {
180
-
package = pkg_str; kind; exit_status = 1;
181
-
deps = []; hashes = [];
160
+
let fail_meta : Day11_layer.Meta.t = {
161
+
exit_status = 1;
162
+
parent_hashes = [];
182
163
uid = benv.uid; gid = benv.gid;
183
164
base_hash = benv.base.hash;
184
-
installed_libs = []; installed_docs = []; patches = []; failed_dep = None;
185
165
disk_usage = 0;
186
-
timing = Day11_layer.Layer_meta.empty_timing;
166
+
timing = Day11_layer.Meta.empty_timing;
187
167
created_at = "";
168
+
failed_dep = None;
188
169
} in
189
-
let _ = Day11_layer.Layer_meta.save_build layer_json fail_meta in
170
+
let _ = Day11_layer.Meta.save layer_json fail_meta in
171
+
on_extract ~layer_dir ~success:false;
190
172
Ok ())
191
173
in
192
174
if Bos.OS.File.exists layer_json |> Result.get_ok then
+27
-13
day11/build/build_layer.mli
+27
-13
day11/build/build_layer.mli
···
1
-
(** Build one package in a container. *)
1
+
(** Build one layer in a container.
2
+
3
+
[build_layer] handles the container lifecycle for a single layer
4
+
build: locking, mount stacking, runc invocation, cleanup, and
5
+
writing the generic [layer.json]. It does NOT write any
6
+
domain-specific sidecar — that's the caller's job, via the
7
+
[~on_extract] callback. *)
2
8
3
9
val opam_build_cleanup : Eio_unix.Stdenv.base -> Fpath.t -> unit
4
-
(** Remove .opam-switch/build/, sources/, packages/cache, /tmp,
5
-
and repo state cache from an upper dir. Suitable for any layer
10
+
(** Remove [.opam-switch/build/], [sources/], [packages/cache], [/tmp],
11
+
and [repo state-*.cache] from an upper dir. Suitable for any layer
6
12
built with opam. *)
7
13
8
14
val build :
···
12
18
?mounts:Day11_container.Mount.t list ->
13
19
?patches:Patches.t ->
14
20
?skip_state_dump:bool ->
15
-
?kind:Day11_layer.Layer_meta.kind ->
16
-
Day11_layer.Layer_type.build ->
21
+
?on_extract:(layer_dir:Fpath.t -> success:bool -> unit) ->
22
+
Day11_opam_layer.Build.t ->
17
23
?strategy:Types.build_strategy ->
18
24
unit ->
19
25
Types.build_result
20
-
(** [build env benv ?patches node ()] builds the package described
21
-
by [node] in a container. When [patches] has entries for this
22
-
package, patch files are mounted and applied before building.
23
-
Uses {!opam_build_strategy} by default.
26
+
(** [build env benv ?on_extract node ()] builds [node] in a
27
+
container, writes its generic [layer.json], and calls
28
+
[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).
24
31
25
-
[kind] is recorded in the layer metadata. Defaults to
26
-
{!Day11_layer.Layer_meta.Build}. Doc-phase callers should pass
27
-
{!Day11_layer.Layer_meta.Compile}, {!Day11_layer.Layer_meta.Link},
28
-
or {!Day11_layer.Layer_meta.Doc_all}. *)
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.
41
+
42
+
Default strategy is {!opam_build_strategy}. *)
+3
-1
day11/build/dag.ml
+3
-1
day11/build/dag.ml
+1
-1
day11/build/dag.mli
+1
-1
day11/build/dag.mli
···
7
7
Hash_cache.t ->
8
8
base_hash:string ->
9
9
(OpamPackage.t * Day11_graph.Graph.solution) list ->
10
-
Day11_layer.Layer_type.build list
10
+
Day11_opam_layer.Build.t list
11
11
(** [build_dag cache ~base_hash solutions] builds a deduplicated
12
12
DAG of build nodes across all solutions. *)
13
13
+3
-1
day11/build/dag_executor.ml
+3
-1
day11/build/dag_executor.ml
+7
-7
day11/build/dag_executor.mli
+7
-7
day11/build/dag_executor.mli
···
11
11
Eio_unix.Stdenv.base ->
12
12
np:int ->
13
13
on_complete:(total:int -> completed:int -> failed:int ->
14
-
Day11_layer.Layer_type.build -> bool -> unit) ->
15
-
on_cascade:(failed:Day11_layer.Layer_type.build ->
16
-
failed_dep:Day11_layer.Layer_type.build -> unit) ->
17
-
?priority:(Day11_layer.Layer_type.build -> int) ->
18
-
?is_cached:(Day11_layer.Layer_type.build -> bool) ->
19
-
Day11_layer.Layer_type.build list ->
20
-
(Day11_layer.Layer_type.build -> bool) ->
14
+
Day11_opam_layer.Build.t -> bool -> unit) ->
15
+
on_cascade:(failed:Day11_opam_layer.Build.t ->
16
+
failed_dep:Day11_opam_layer.Build.t -> unit) ->
17
+
?priority:(Day11_opam_layer.Build.t -> int) ->
18
+
?is_cached:(Day11_opam_layer.Build.t -> bool) ->
19
+
Day11_opam_layer.Build.t list ->
20
+
(Day11_opam_layer.Build.t -> bool) ->
21
21
unit
22
22
(** [execute env ~np ~on_complete ~on_cascade ?priority ?is_cached nodes build_one]
23
23
executes [nodes] in dependency order with up to [np] concurrent
+16
-13
day11/build/debug.ml
+16
-13
day11/build/debug.ml
···
1
-
open Day11_layer.Layer_type
1
+
module Build = Day11_opam_layer.Build
2
+
module Tool = Day11_opam_layer.Tool
3
+
type build = Build.t
2
4
3
5
type session = {
4
6
temp_dir : Fpath.t;
···
17
19
18
20
let setup env ~os_dir ?(keep = false) node =
19
21
let cache_dir = Fpath.parent os_dir in
20
-
let layer_dir = build_dir ~os_dir node in
22
+
let layer_dir = Build.dir ~os_dir node in
21
23
let layer_json = Fpath.(layer_dir / "layer.json") in
22
-
match Day11_layer.Layer_meta.load_build layer_json with
24
+
match Day11_layer.Meta.load layer_json with
23
25
| Error _ as e -> e
24
26
| Ok meta ->
25
27
(* Reconstruct base *)
26
28
let base_dir = Fpath.(cache_dir / "base") in
27
-
let base : base = {
29
+
let base : Day11_layer.Base.t = {
28
30
hash = meta.base_hash; dir = base_dir; image = "";
29
31
} in
30
32
let uid = meta.uid and gid = meta.gid in
···
75
77
if Bos.OS.Dir.exists packages_path |> Result.get_ok then begin
76
78
let state_dir = Fpath.(upper // switch_rel) in
77
79
Bos.OS.Dir.create ~path:true state_dir |> ignore;
78
-
Day11_layer.Opamh.dump_state [ packages_path ]
80
+
Day11_opam_layer.Opamh.dump_state [ packages_path ]
79
81
Fpath.(state_dir / "switch-state") |> ignore
80
82
end;
81
83
(* Mount overlay *)
···
90
92
"opam source %s --dir=/home/opam/src"
91
93
(OpamPackage.to_string node.pkg) in
92
94
let spec = Day11_container.Oci_spec.make
93
-
~terminal:false ~root:(Fpath.to_string rootfs)
94
95
~cwd:"/home/opam"
96
+
~hostname:"debug" ~env:debug_env ~network:true
97
+
~root:(Fpath.to_string rootfs)
95
98
~argv:[ "/usr/bin/env"; "bash"; "-c"; source_cmd ]
96
-
~hostname:"debug" ~uid ~gid ~env:debug_env
97
-
~mounts:[] ~network:true in
98
-
ignore (Day11_container.Runc.write_spec temp_dir spec);
99
+
~uid ~gid () in
100
+
ignore (Day11_container.Oci_spec.write temp_dir spec);
99
101
let container_id = Printf.sprintf "debug-src-%d" (Unix.getpid ()) in
100
102
ignore (Day11_container.Runc.delete env container_id);
101
103
ignore (Day11_container.Runc.run env ~bundle:temp_dir ~container_id);
···
107
109
let rootfs = Fpath.(session.temp_dir / "rootfs") in
108
110
let uid = session.uid and gid = session.gid in
109
111
let spec = Day11_container.Oci_spec.make
110
-
~terminal ~root:(Fpath.to_string rootfs)
112
+
~terminal
111
113
~cwd:"/home/opam/src"
112
-
~argv ~hostname:"debug" ~uid ~gid ~env:debug_env
113
-
~mounts:[] ~network:true in
114
-
ignore (Day11_container.Runc.write_spec session.temp_dir spec);
114
+
~hostname:"debug" ~env:debug_env ~network:true
115
+
~root:(Fpath.to_string rootfs)
116
+
~argv ~uid ~gid () in
117
+
ignore (Day11_container.Oci_spec.write session.temp_dir spec);
115
118
let container_id = Printf.sprintf "debug-%d" (Unix.getpid ()) in
116
119
ignore (Day11_container.Runc.delete env container_id);
117
120
let result = match
+2
-2
day11/build/debug.mli
+2
-2
day11/build/debug.mli
···
7
7
type session = {
8
8
temp_dir : Fpath.t;
9
9
os_dir : Fpath.t;
10
-
build : Day11_layer.Layer_type.build;
10
+
build : Day11_opam_layer.Build.t;
11
11
pkg : OpamPackage.t;
12
12
uid : int;
13
13
gid : int;
···
17
17
Eio_unix.Stdenv.base ->
18
18
os_dir:Fpath.t ->
19
19
?keep:bool ->
20
-
Day11_layer.Layer_type.build ->
20
+
Day11_opam_layer.Build.t ->
21
21
(session, [> Rresult.R.msg ]) result
22
22
(** [setup env ~os_dir ?keep node] prepares a debug container for
23
23
[node]. Reads uid/gid/base from the layer's metadata. Derives
+1
-1
day11/build/dune
+1
-1
day11/build/dune
+12
-11
day11/build/run_in_layers.ml
+12
-11
day11/build/run_in_layers.ml
···
29
29
Log.info (fun m -> m "%s: %.3fs" name elapsed);
30
30
r
31
31
32
-
let run env ~(base : Day11_layer.Layer_type.base)
33
-
~build_dirs
34
-
~uid ~gid ?(mounts = []) ?(skip_state_dump = false) cmd =
32
+
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
35
36
let t_total = Unix.gettimeofday () in
36
37
let t_merge = ref 0. in
37
38
let t_dump = ref 0. in
···
40
41
let t_runc = ref 0. in
41
42
let t_umount = ref 0. in
42
43
let t_cleanup = ref 0. in
43
-
let base_fs = Fpath.add_seg base.dir "fs" in
44
+
let base_fs = Fpath.add_seg benv.base.dir "fs" in
44
45
let switch = Types.switch in
45
46
let temp_dir =
46
47
let tmp = Fpath.v (Filename.get_temp_dir_name ()) in
···
139
140
if packages_dirs <> [] then begin
140
141
let state_dir = Fpath.(upper // switch_rel) in
141
142
mkdir state_dir;
142
-
Day11_layer.Opamh.dump_state packages_dirs
143
+
Day11_opam_layer.Opamh.dump_state packages_dirs
143
144
Fpath.(state_dir / "switch-state") |> ignore
144
145
end);
145
146
(* Chown upper for overlay permissions *)
···
174
175
(fun () ->
175
176
let spec =
176
177
Day11_container.Oci_spec.make
177
-
~terminal:false
178
-
~root:(Fpath.to_string merged)
179
178
~cwd:"/home/opam"
180
-
~argv:[ "/usr/bin/env"; "bash"; "-c"; cmd ]
181
179
~hostname:"builder"
182
-
~uid ~gid
183
180
~env:container_env
184
181
~mounts
185
182
~network:true
183
+
~root:(Fpath.to_string merged)
184
+
~argv:[ "/usr/bin/env"; "bash"; "-c"; cmd ]
185
+
~uid ~gid
186
+
()
186
187
in
187
-
let* () = Day11_container.Runc.write_spec temp_dir spec in
188
+
let* () = Day11_container.Oci_spec.write temp_dir spec in
188
189
let container_id =
189
190
Printf.sprintf "day11-%s-%d"
190
191
(String.sub (Fpath.basename temp_dir) 0
···
202
203
in
203
204
(* Always clean up internals — only upper survives *)
204
205
timed_to "cleanup internals" t_cleanup (fun () -> cleanup_internals ());
205
-
let timing : Day11_layer.Layer_meta.timing = [
206
+
let timing : Day11_layer.Meta.timing = [
206
207
"merge", !t_merge;
207
208
"dump_state", !t_dump;
208
209
"chown", !t_chown;
+8
-9
day11/build/run_in_layers.mli
+8
-9
day11/build/run_in_layers.mli
···
5
5
6
6
val run :
7
7
Eio_unix.Stdenv.base ->
8
-
base:Day11_layer.Layer_type.base ->
8
+
Types.build_env ->
9
9
build_dirs:Fpath.t list ->
10
-
uid:int ->
11
-
gid:int ->
12
10
?mounts:Day11_container.Mount.t list ->
13
11
?skip_state_dump:bool ->
14
12
string ->
15
-
(Day11_exec.Run.t * Fpath.t * Day11_layer.Layer_meta.timing,
13
+
(Day11_exec.Run.t * Fpath.t * Day11_layer.Meta.timing,
16
14
[> Rresult.R.msg ]) result
17
-
(** [run env ~base ~build_dirs ~uid ~gid ?mounts cmd] runs [cmd]
18
-
in a container with [base] and [build_dirs] stacked as an overlay.
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].
19
18
20
19
Returns [(run_result, upper_dir, timing)] on success. [timing]
21
-
records how long each phase took (merge, dump_state, overlay mount,
22
-
runc run, cleanup, etc.). The caller is responsible for extracting
23
-
what they need and cleaning up. *)
20
+
records how long each phase took (merge, dump_state, overlay
21
+
mount, runc run, cleanup, etc.). The caller is responsible for
22
+
extracting what they need from [upper_dir] and cleaning it up. *)
+5
-5
day11/build/test/test_build.ml
+5
-5
day11/build/test/test_build.ml
···
18
18
()
19
19
20
20
let test_build_node () =
21
-
let node : Day11_layer.Layer_type.build = {
21
+
let node : Day11_opam_layer.Build.t = {
22
22
hash = "build-abc123";
23
23
pkg = pkg "yojson.2.2.2";
24
24
deps = [{ hash = "build-def456"; pkg = pkg "dune.3.0"; deps = []; universe = Day11_graph.Universe.dummy }];
···
103
103
~base_hash:"base"
104
104
[ (pkg "b.1", solution) ] in
105
105
Alcotest.(check int) "2 nodes" 2 (List.length nodes);
106
-
let names = List.map (fun (n : Day11_layer.Layer_type.build) ->
106
+
let names = List.map (fun (n : Day11_opam_layer.Build.t) ->
107
107
OpamPackage.to_string n.pkg) nodes in
108
108
Alcotest.(check (list string)) "topo order" [ "c.1"; "b.1" ] names
109
109
···
129
129
[ (pkg "a.1", sol1); (pkg "b.1", sol2) ] in
130
130
(* c.1, a.1, b.1 — c.1 appears once despite being in 2 solutions *)
131
131
Alcotest.(check int) "3 nodes (c deduplicated)" 3 (List.length nodes);
132
-
let c_nodes = List.filter (fun (n : Day11_layer.Layer_type.build) ->
132
+
let c_nodes = List.filter (fun (n : Day11_opam_layer.Build.t) ->
133
133
OpamPackage.to_string n.pkg = "c.1") nodes in
134
134
Alcotest.(check int) "1 c node" 1 (List.length c_nodes)
135
135
···
152
152
let cache = Hash_cache.create ~find_opam () in
153
153
let nodes = Dag.build_dag cache ~base_hash:"base"
154
154
[ (pkg "c.1", sol1); (pkg "c.1", sol2) ] in
155
-
let c_nodes = List.filter (fun (n : Day11_layer.Layer_type.build) ->
155
+
let c_nodes = List.filter (fun (n : Day11_opam_layer.Build.t) ->
156
156
OpamPackage.to_string n.pkg = "c.1") nodes in
157
157
(* c.1 with dep d.1 vs c.1 with dep e.1 — different universes *)
158
158
Alcotest.(check int) "2 c nodes (different universes)" 2 (List.length c_nodes);
···
177
177
let cache = Hash_cache.create ~find_opam () in
178
178
let nodes = Dag.build_dag cache ~base_hash:"base"
179
179
[ (pkg "b.1", solution) ] in
180
-
let b_node = List.find (fun (n : Day11_layer.Layer_type.build) ->
180
+
let b_node = List.find (fun (n : Day11_opam_layer.Build.t) ->
181
181
OpamPackage.to_string n.pkg = "b.1") nodes in
182
182
(* b.1's universe should include c.1 and d.1 (transitive deps) *)
183
183
let expected = Day11_graph.Universe.of_deps
+4
-4
day11/build/test/test_build_integration.ml
+4
-4
day11/build/test/test_build_integration.ml
···
21
21
let pkg = OpamPackage.of_string "astring.0.8.5" in
22
22
let layer_hash = Day11_layer.Hash.of_strings
23
23
[ "build"; base.hash; "astring.0.8.5" ] in
24
-
let node : Day11_layer.Layer_type.build =
24
+
let node : Day11_opam_layer.Build.t =
25
25
{ hash = layer_hash; pkg; deps = []; universe = Day11_graph.Universe.dummy } in
26
26
let result =
27
27
Build_layer.build env benv
···
35
35
(match result with
36
36
| Types.Success bl ->
37
37
Printf.printf "SUCCESS: %s\n%!" bl.hash;
38
-
let installed = Day11_layer.Installed_files.scan_libs
39
-
~layer_dir:(Day11_layer.Layer_type.build_dir ~os_dir:benv.os_dir bl) in
38
+
let installed = Day11_opam_layer.Installed_files.scan_libs
39
+
~layer_dir:(Day11_opam_layer.Build.dir ~os_dir:benv.os_dir bl) in
40
40
Printf.printf "Installed: %d lib files\n%!" (List.length installed);
41
41
Alcotest.(check bool) "has astring"
42
42
true (List.exists (fun f ->
···
56
56
let pkg = OpamPackage.of_string "astring.0.8.5" in
57
57
let layer_hash = Day11_layer.Hash.of_strings
58
58
[ "build"; base.hash; "astring.0.8.5" ] in
59
-
let node : Day11_layer.Layer_type.build =
59
+
let node : Day11_opam_layer.Build.t =
60
60
{ hash = layer_hash; pkg; deps = []; universe = Day11_graph.Universe.dummy } in
61
61
let t0 = Unix.gettimeofday () in
62
62
let result =
+5
-5
day11/build/test/test_from_scratch.ml
+5
-5
day11/build/test/test_from_scratch.ml
···
40
40
let cache = Hash_cache.create ~find_opam () in
41
41
let benv = Types.make_build_env ~base ~os_dir ~uid:1000 ~gid:1000 () in
42
42
let _final =
43
-
List.fold_left (fun (deps : Day11_layer.Layer_type.build list) pkg ->
43
+
List.fold_left (fun (deps : Day11_opam_layer.Build.t list) pkg ->
44
44
let pkg_str = OpamPackage.to_string pkg in
45
45
let all_pkgs = [ pkg ] in
46
46
let layer_hash =
47
47
Hash_cache.layer_hash cache ~base_hash:base.hash all_pkgs in
48
-
let node : Day11_layer.Layer_type.build =
48
+
let node : Day11_opam_layer.Build.t =
49
49
{ hash = layer_hash; pkg; deps; universe = Day11_graph.Universe.dummy } in
50
50
Printf.printf "\n--- Building %s (layer: %s, deps: %d) ---\n%!"
51
-
pkg_str (Day11_layer.Layer_type.build_dir_name node) (List.length deps);
51
+
pkg_str (Day11_opam_layer.Build.dir_name node) (List.length deps);
52
52
let result =
53
53
Build_layer.build env benv
54
54
~opam_repositories:[]
···
57
57
match result with
58
58
| Types.Success bl ->
59
59
Printf.printf "OK: %s → %s\n%!" pkg_str bl.hash;
60
-
let installed = Day11_layer.Installed_files.scan_libs
61
-
~layer_dir:(Day11_layer.Layer_type.build_dir ~os_dir:benv.os_dir bl) in
60
+
let installed = Day11_opam_layer.Installed_files.scan_libs
61
+
~layer_dir:(Day11_opam_layer.Build.dir ~os_dir:benv.os_dir bl) in
62
62
Printf.printf " Installed: %d lib files\n%!" (List.length installed);
63
63
deps @ [ bl ]
64
64
| Types.Failure name ->
+6
-6
day11/build/test/test_layered_build.ml
+6
-6
day11/build/test/test_layered_build.ml
···
26
26
let benv : Types.build_env =
27
27
{ base; os_dir; uid = 1000; gid = 1000 } in
28
28
let _final =
29
-
List.fold_left (fun (deps : Day11_layer.Layer_type.build list) pkg_str ->
29
+
List.fold_left (fun (deps : Day11_opam_layer.Build.t list) pkg_str ->
30
30
let pkg = OpamPackage.of_string pkg_str in
31
-
let dep_hashes = List.map (fun (d : Day11_layer.Layer_type.build) -> d.hash) deps in
31
+
let dep_hashes = List.map (fun (d : Day11_opam_layer.Build.t) -> d.hash) deps in
32
32
let layer_hash = Day11_layer.Hash.of_strings
33
33
([ "build"; base.hash; pkg_str ] @ dep_hashes) in
34
-
let node : Day11_layer.Layer_type.build =
34
+
let node : Day11_opam_layer.Build.t =
35
35
{ hash = layer_hash; pkg; deps; universe = Day11_graph.Universe.dummy } in
36
36
Printf.printf "\n--- Building %s (layer: %s, deps: %d) ---\n%!"
37
-
pkg_str (Day11_layer.Layer_type.build_dir_name node) (List.length deps);
37
+
pkg_str (Day11_opam_layer.Build.dir_name node) (List.length deps);
38
38
let result =
39
39
Build_layer.build env benv
40
40
~opam_repositories:[]
···
46
46
match result with
47
47
| Types.Success bl ->
48
48
Printf.printf "OK: %s → %s\n%!" pkg_str bl.hash;
49
-
let installed = Day11_layer.Installed_files.scan_libs
50
-
~layer_dir:(Day11_layer.Layer_type.build_dir ~os_dir:benv.os_dir bl) in
49
+
let installed = Day11_opam_layer.Installed_files.scan_libs
50
+
~layer_dir:(Day11_opam_layer.Build.dir ~os_dir:benv.os_dir bl) in
51
51
Printf.printf " Installed: %d lib files\n%!" (List.length installed);
52
52
deps @ [ bl ]
53
53
| Types.Failure name ->
+2
-2
day11/build/test/test_tools.ml
+2
-2
day11/build/test/test_tools.ml
···
30
30
(List.length tool.builds);
31
31
Alcotest.(check bool) "has layers" true
32
32
(List.length tool.builds > 0);
33
-
let libs = Day11_layer.Installed_files.scan_libs
33
+
let libs = Day11_opam_layer.Installed_files.scan_libs
34
34
~layer_dir:tool.dir in
35
35
Alcotest.(check bool) "has astring libs" true
36
36
(List.exists (fun f ->
···
88
88
in
89
89
Printf.printf "odoc (pinned) built: %d layers\n%!"
90
90
(List.length tool.builds);
91
-
let compiler_layer = List.find_opt (fun (bl : Day11_layer.Layer_type.build) ->
91
+
let compiler_layer = List.find_opt (fun (bl : Day11_opam_layer.Build.t) ->
92
92
Astring.String.is_prefix ~affix:"ocaml-compiler"
93
93
(OpamPackage.to_string bl.pkg)
94
94
) tool.builds in
+3
-3
day11/build/test/test_tools_pinned.ml
+3
-3
day11/build/test/test_tools_pinned.ml
···
120
120
(* Check that all doc binaries exist across built layers *)
121
121
let os_dir = Fpath.(cache_dir / "linux-x86_64") in
122
122
let find_binary name =
123
-
List.exists (fun (bl : Day11_layer.Layer_type.build) ->
124
-
let dir = Day11_layer.Layer_type.build_dir ~os_dir bl in
123
+
List.exists (fun (bl : Day11_opam_layer.Build.t) ->
124
+
let dir = Day11_opam_layer.Build.dir ~os_dir bl in
125
125
let bin = Fpath.(dir / "fs" / "home" / "opam" / ".opam"
126
126
/ Types.switch / "bin" / name) in
127
127
Bos.OS.File.exists bin |> Result.get_ok
···
137
137
let pinned_pkgs = [ "odoc"; "odoc-parser"; "odoc-md"; "sherlodoc";
138
138
"odoc-driver" ] in
139
139
List.iter (fun name ->
140
-
let found = List.exists (fun (bl : Day11_layer.Layer_type.build) ->
140
+
let found = List.exists (fun (bl : Day11_opam_layer.Build.t) ->
141
141
let pkg_name = OpamPackage.Name.to_string (OpamPackage.name bl.pkg) in
142
142
pkg_name = name
143
143
) tool.builds in
+4
-4
day11/build/test_noop/test_executor.ml
+4
-4
day11/build/test_noop/test_executor.ml
···
6
6
let np = int_of_string Sys.argv.(2) in
7
7
let sleep_ms = float_of_string Sys.argv.(3) in
8
8
(* Load DAG from JSONL *)
9
-
let nodes_by_hash : (string, Day11_layer.Layer_type.build) Hashtbl.t =
9
+
let nodes_by_hash : (string, Day11_opam_layer.Build.t) Hashtbl.t =
10
10
Hashtbl.create 100000 in
11
11
let ic = open_in dag_file in
12
12
let count = ref 0 in
···
20
20
|> List.map to_string in
21
21
let pkg = OpamPackage.of_string pkg_str in
22
22
(* Store without deps first, patch later *)
23
-
let node : Day11_layer.Layer_type.build =
23
+
let node : Day11_opam_layer.Build.t =
24
24
{ hash; pkg; deps = []; universe = Day11_graph.Universe.dummy } in
25
25
Hashtbl.replace nodes_by_hash hash node;
26
26
ignore dep_hashes;
···
41
41
) dep_hashes in
42
42
let pkg = (Hashtbl.find nodes_by_hash hash).pkg in
43
43
Hashtbl.replace nodes_by_hash hash
44
-
{ Day11_layer.Layer_type.hash; pkg; deps; universe = Day11_graph.Universe.dummy }
44
+
{ Day11_opam_layer.Build.hash; pkg; deps; universe = Day11_graph.Universe.dummy }
45
45
done with End_of_file -> close_in ic);
46
46
let all_nodes = Hashtbl.fold (fun _ n acc -> n :: acc)
47
47
nodes_by_hash [] in
48
-
let all_nodes = List.sort (fun (a : Day11_layer.Layer_type.build) b ->
48
+
let all_nodes = List.sort (fun (a : Day11_opam_layer.Build.t) b ->
49
49
compare (List.length a.deps) (List.length b.deps)) all_nodes in
50
50
Printf.printf "Running executor with %d workers, %.0fms sleep...\n%!" np sleep_ms;
51
51
let active = Atomic.make 0 in
+6
-4
day11/build/tools.ml
+6
-4
day11/build/tools.ml
···
1
1
let src = Logs.Src.create "day11.build.tools" ~doc:"Tool building"
2
2
module Log = (val Logs.src_log src)
3
3
4
-
open Day11_layer.Layer_type
4
+
module Build = Day11_opam_layer.Build
5
+
module Tool = Day11_opam_layer.Tool
6
+
type build = Build.t
5
7
6
8
let read_pins_from_dir dir =
7
9
let opam_files = Sys.readdir dir |> Array.to_list
···
54
56
[ (target, solution) ] in
55
57
let last = List.find (fun (n : build) ->
56
58
OpamPackage.equal n.pkg target) nodes in
57
-
let tool_dir = build_dir ~os_dir:benv.os_dir last in
59
+
let tool_dir = Build.dir ~os_dir:benv.os_dir last in
58
60
Log.info (fun m -> m "Tool %s: %d nodes in DAG"
59
61
pkg_str (List.length nodes));
60
-
Ok ({ hash = last.hash; dir = tool_dir;
62
+
Ok ({ Tool.hash = last.hash; dir = tool_dir;
61
63
builds = nodes },
62
64
source_dirs)
63
65
···
77
79
| Ok (tool, source_dirs) ->
78
80
let nodes = tool.builds in
79
81
Printf.printf " Solution packages:\n%!";
80
-
List.iter (fun (node : Day11_layer.Layer_type.build) ->
82
+
List.iter (fun (node : Day11_opam_layer.Build.t) ->
81
83
Printf.printf " %s (%d deps)\n%!"
82
84
(OpamPackage.to_string node.pkg) (List.length node.deps)
83
85
) nodes;
+3
-3
day11/build/tools.mli
+3
-3
day11/build/tools.mli
···
16
16
?source_dirs:string OpamPackage.Name.Map.t ->
17
17
?cache:Hash_cache.t ->
18
18
OpamPackage.t ->
19
-
(Day11_layer.Layer_type.tool * string OpamPackage.Name.Map.t,
19
+
(Day11_opam_layer.Tool.t * string OpamPackage.Name.Map.t,
20
20
[> Rresult.R.msg ]) result
21
21
(** [plan_tool benv ~packages ~repos ?cache target] solves [target]
22
22
via solver_worker and creates DAG nodes without building.
···
38
38
?source_dirs:string OpamPackage.Name.Map.t ->
39
39
?mounts:Day11_container.Mount.t list ->
40
40
OpamPackage.t ->
41
-
(Day11_layer.Layer_type.tool, [> Rresult.R.msg ]) result
41
+
(Day11_opam_layer.Tool.t, [> Rresult.R.msg ]) result
42
42
(** [build_tool env benv ?np ~packages ~repos target] solves and builds
43
43
[target] and all its dependencies via solver_worker subprocesses.
44
44
[pin_dirs] are directories of [.opam] files pinned at version [dev].
···
65
65
repo_dir:string ->
66
66
target_name:string ->
67
67
unit ->
68
-
(Day11_layer.Layer_type.tool, [> Rresult.R.msg ]) result
68
+
(Day11_opam_layer.Tool.t, [> Rresult.R.msg ]) result
69
69
(** [build_tool_from_repo env benv ~packages ~repos ~repo_dir
70
70
?extra_repo_dirs ~target_name ()] reads [.opam] files from
71
71
[repo_dir] and each [extra_repo_dirs], pins all packages found
+6
-3
day11/build/types.ml
+6
-3
day11/build/types.ml
···
1
-
open Day11_layer.Layer_type
1
+
module Build = Day11_opam_layer.Build
2
+
module Tool = Day11_opam_layer.Tool
3
+
type build = Build.t
4
+
type tool = Tool.t
2
5
3
6
type build_env = {
4
-
base : base;
7
+
base : Day11_layer.Base.t;
5
8
os_dir : Fpath.t;
6
9
uid : int;
7
10
gid : int;
···
19
22
let switch = "default"
20
23
21
24
type build_result =
22
-
| Success of build
25
+
| Success of Day11_opam_layer.Build.t
23
26
| Failure of string
24
27
| Dependency_failed
25
28
| No_solution of string
+7
-4
day11/build/types.mli
+7
-4
day11/build/types.mli
···
1
1
(** Build types. *)
2
2
3
-
open Day11_layer.Layer_type
3
+
module Build = Day11_opam_layer.Build
4
+
module Tool = Day11_opam_layer.Tool
5
+
type build = Build.t
6
+
type tool = Tool.t
4
7
5
8
type build_env = {
6
-
base : base;
9
+
base : Day11_layer.Base.t;
7
10
os_dir : Fpath.t;
8
11
uid : int;
9
12
gid : int;
···
12
15
The opam switch is always ["default"]. *)
13
16
14
17
val make_build_env :
15
-
base:base -> os_dir:Fpath.t ->
18
+
base:Day11_layer.Base.t -> os_dir:Fpath.t ->
16
19
?uid:int -> ?gid:int -> unit -> build_env
17
20
18
21
val packages_dir : build_env -> Fpath.t
···
20
23
val switch : string
21
24
22
25
type build_result =
23
-
| Success of build
26
+
| Success of Day11_opam_layer.Build.t
24
27
| Failure of string
25
28
| Dependency_failed
26
29
| No_solution of string
+123
-116
day11/container/README.md
+123
-116
day11/container/README.md
···
1
-
# container — Container runtime primitives
1
+
# container — OCI container runtime primitives
2
2
3
-
OCI/runc container lifecycle primitives. Generates OCI specs, manages
4
-
overlay filesystems, and executes commands via runc.
3
+
Thin wrappers around Linux overlayfs and [runc](https://github.com/opencontainers/runc)
4
+
for running isolated commands in a layered rootfs. This is the lowest
5
+
level at which day11 touches the kernel: it knows how to mount
6
+
filesystems, build an OCI runtime spec, and launch/delete a container
7
+
— nothing more.
5
8
6
-
This library has no domain knowledge — it does not know about packages,
7
-
doc generation, JTW, blessings, or build orchestration. The `build`,
8
-
`doc`, and `jtw` libraries compose these primitives for their specific
9
-
workflows.
9
+
No domain knowledge. This library does not know about opam packages,
10
+
layers in the day11 sense, caching, doc generation, or builds. It is
11
+
composed by `day11/build` (which adds all those concerns) to run one
12
+
container per package build.
10
13
11
14
## External dependencies
12
15
13
-
- `exec` (sudo for overlay mount, runc execution)
14
-
- `yojson` (OCI spec generation)
16
+
- `day11_exec` — sudo wrappers
17
+
- `yojson` — config.json generation
18
+
- `bos`, `fpath`, `rresult` — filesystem/error helpers
15
19
16
-
Does NOT depend on `layer`, `opam-format`, or `dockerfile`.
20
+
Does NOT depend on `day11_layer`, `day11_opam`, `opam-format`, or any
21
+
solver/build libraries.
17
22
18
23
## Modules
19
24
20
-
### `Mount` — mount specification
25
+
### `Mount` — bind-mount specs for application inputs
21
26
22
27
```ocaml
23
28
type t = { ty : string; src : string; dst : string; options : string list }
···
26
31
val bind_rw : src:string -> string -> t
27
32
```
28
33
29
-
### `Oci_spec` — OCI runtime specification generation
34
+
`Mount.t` values are passed to `Oci_spec.make` via `~mounts`. The
35
+
system mounts every container needs (`/proc`, `/sys`, `/dev/*`,
36
+
`/tmp`) are added automatically by `Oci_spec.make` — callers only
37
+
supply application-specific bind mounts (opam repo overlay, patches,
38
+
odoc output trees, etc.).
30
39
31
-
Pure JSON generation — no I/O. Generates the config.json for runc.
40
+
### `Oci_spec` — generate runc's config.json
32
41
33
42
```ocaml
34
43
val make :
35
-
terminal:bool -> root:string -> cwd:string -> argv:string list ->
36
-
hostname:string -> uid:int -> gid:int ->
37
-
env:(string * string) list -> mounts:Mount.t list ->
38
-
network:bool -> Yojson.Safe.t
44
+
?terminal:bool -> ?cwd:string -> ?hostname:string ->
45
+
?env:(string * string) list -> ?mounts:Mount.t list -> ?network:bool ->
46
+
root:string -> argv:string list -> uid:int -> gid:int ->
47
+
unit ->
48
+
Yojson.Safe.t
49
+
50
+
val write : Fpath.t -> Yojson.Safe.t -> (unit, [> Rresult.R.msg]) result
39
51
```
40
52
41
-
Includes Linux namespaces (pid, ipc, uts, mount, optionally network),
42
-
capabilities (Docker-default subset), seccomp (fsync → ERRNO 0 for
43
-
build performance), and standard system mounts.
53
+
`make` is a pure function that builds an OCI runtime spec. Nearly
54
+
everything in that spec is boilerplate, hardcoded here with sensible
55
+
defaults:
44
56
45
-
### `Overlay` — overlay filesystem management
57
+
- Linux namespaces: pid, ipc, uts, mount (+ network when
58
+
`~network:false`).
59
+
- Capabilities: Docker's baseline (CAP_CHOWN, CAP_DAC_OVERRIDE,
60
+
CAP_FSETID, CAP_FOWNER, CAP_MKNOD, CAP_SETGID, CAP_SETUID,
61
+
CAP_SETFCAP, CAP_SETPCAP, CAP_SYS_CHROOT, CAP_KILL, CAP_AUDIT_WRITE).
62
+
- Seccomp: `fsync`, `fdatasync`, `msync`, `sync`, `syncfs`,
63
+
`sync_file_range` all return `ERRNO 0`. This is a deliberate
64
+
performance hack — build containers don't need durability.
65
+
- System mounts: `/proc`, `/sys`, `/dev`, `/dev/pts`, `/dev/shm`,
66
+
`/dev/mqueue`, `/sys/fs/cgroup`, `/tmp`.
67
+
- `rlimits`: `RLIMIT_NOFILE = 1024`.
68
+
69
+
`write` saves the spec as `<bundle>/config.json`. Split from `make`
70
+
so callers can inspect or tweak the spec before writing.
71
+
72
+
### `Overlay` — overlayfs mount/umount
46
73
47
74
```ocaml
48
75
val mount : Eio_unix.Stdenv.base ->
49
76
lower:Fpath.t list -> upper:Fpath.t -> work:Fpath.t ->
50
77
target:Fpath.t -> (unit, [> Rresult.R.msg]) result
51
-
val umount : Eio_unix.Stdenv.base -> Fpath.t -> (unit, [> Rresult.R.msg]) result
78
+
79
+
val umount : Eio_unix.Stdenv.base -> Fpath.t ->
80
+
(unit, [> Rresult.R.msg]) result
52
81
```
53
82
54
-
### `Runc` — OCI container runtime
83
+
Shells out to `sudo mount -t overlay` and `sudo umount`. The `lower`
84
+
list uses the kernel's convention: leftmost entry is the topmost
85
+
layer, so files in `lower.(0)` shadow files in `lower.(1)` shadow
86
+
files in `lower.(2)`. Directories are merged across all lowers.
87
+
88
+
### `Runc` — container run/delete
55
89
56
90
```ocaml
57
-
val run : Eio_unix.Stdenv.base -> bundle:Fpath.t -> container_id:string ->
58
-
(Run.t, [> Rresult.R.msg]) result
59
-
val delete : Eio_unix.Stdenv.base -> string -> (unit, [> Rresult.R.msg]) result
60
-
val write_spec : Fpath.t -> Yojson.Safe.t -> (unit, [> Rresult.R.msg]) result
91
+
val run : Eio_unix.Stdenv.base ->
92
+
bundle:Fpath.t -> container_id:string ->
93
+
(Day11_exec.Run.t, [> Rresult.R.msg]) result
94
+
95
+
val delete : Eio_unix.Stdenv.base -> string ->
96
+
(unit, [> Rresult.R.msg]) result
61
97
```
62
98
63
-
## How `build` works (Linux)
99
+
`run` shells out to `sudo runc run -b <bundle> <container_id>` and
100
+
blocks until the container exits. Captures stdout/stderr to
101
+
`<bundle>/runc.log` as a side effect. The returned
102
+
`Day11_exec.Run.t` carries the container's exit status in its
103
+
`status` field.
64
104
65
-
1. Create temp dir with lower/, fs/ (upperdir), work/, rootfs/
66
-
2. `sudo cp --link` each dep layer's `fs/` into lower/ (hardlinks for speed)
67
-
3. Dump opam switch-state from lower packages dir
68
-
4. Chown the upperdir's /home to build user
69
-
5. `sudo mount -t overlay` combining lower + base + upper
70
-
6. Generate OCI spec JSON
71
-
7. `sudo runc run` with build command
72
-
8. `sudo runc delete`, `sudo umount`, cleanup temp dirs
73
-
9. Return exit status
105
+
`delete` runs `sudo runc delete -f` to clean up runc's on-disk
106
+
registry entry. Callers typically pair `run` with `delete` inside a
107
+
`Fun.protect` so a failed run doesn't leak state.
74
108
75
-
## How `debug` works (Linux)
109
+
## A typical caller
76
110
77
-
1. Same overlay setup as build (reused if `--keep`)
78
-
2. Extract package source via `opam source` in container
79
-
3. Run runc with terminal=true for interactive shell
80
-
4. On `--keep`, leave overlay mounted for resume
81
-
5. Otherwise, teardown overlay
111
+
The call order inside `day11/build/run_in_layers.ml`:
82
112
83
-
## Source in day10
84
-
85
-
| day10 file | What moves here |
86
-
|------------|----------------|
87
-
| `s.ml` | `CONTAINER` module type, `doc_phase` type |
88
-
| `linux.ml` | Full Linux implementation (~1135 lines) |
89
-
| `freebsd.ml` | FreeBSD implementation |
90
-
| `windows.ml` | Windows implementation |
91
-
| `dummy.ml` | Dummy implementation |
92
-
| `mount.ml` | Mount type and helpers |
93
-
| `docker.ml` | Docker image generation |
113
+
```ocaml
114
+
Overlay.mount env ~lower ~upper ~work ~target:merged;
115
+
Fun.protect
116
+
~finally:(fun () -> ignore (Overlay.umount env merged))
117
+
(fun () ->
118
+
let spec = Oci_spec.make
119
+
~cwd:"/home/opam"
120
+
~hostname:"builder"
121
+
~env:container_env
122
+
~mounts
123
+
~network:true
124
+
~root:(Fpath.to_string merged)
125
+
~argv:["/usr/bin/env"; "bash"; "-c"; cmd]
126
+
~uid ~gid
127
+
()
128
+
in
129
+
Oci_spec.write bundle_dir spec;
130
+
let container_id = "day11-" ^ ... in
131
+
ignore (Runc.delete env container_id); (* stale cleanup *)
132
+
Fun.protect
133
+
~finally:(fun () -> ignore (Runc.delete env container_id))
134
+
(fun () -> Runc.run env ~bundle:bundle_dir ~container_id))
135
+
```
94
136
95
137
## Testing
96
138
97
-
### Unit tests (no containers needed)
139
+
### Unit tests
98
140
99
-
- **`Oci_spec`** — `make` with known params produces valid JSON with
100
-
expected namespaces, mounts, env, argv. Verify seccomp section
101
-
includes fsync override. Verify network namespace is toggled by
102
-
`~network` flag.
103
-
- **`Mount`** — `to_json` produces correct structure. `user_mounts`
104
-
filters correctly.
105
-
- **`Docker`** — test the Dockerfile generation (the string, not the
106
-
actual build). Verify stages, package installation, user creation.
141
+
`test/test_container.ml` runs under `dune test` without root. It
142
+
covers:
107
143
108
-
### Integration tests (needs Linux + runc + sudo)
144
+
- `Mount.to_json`, `Mount.bind_ro`, `Mount.bind_rw`
145
+
- `Oci_spec.make` with various combinations (basic spec, env,
146
+
seccomp, network on/off, mounts, capabilities, terminal flag)
147
+
- `Oci_spec.write` — verify the JSON round-trips to disk
109
148
110
-
- **`Linux.build`** — build a trivial package (e.g. an empty opam
111
-
package), verify exit status 0 and layer.json is created.
112
-
- **`Linux.debug`** — start a debug session with a command
113
-
(`echo test`), verify it runs and exits.
114
-
- **`layer_hash`** — verify deterministic: same inputs → same hash.
115
-
Different deps → different hash.
116
-
- **`doc_layer_hash` / `jtw_layer_hash`** — same determinism tests.
149
+
No actual mounts or containers.
117
150
118
-
### Failure mode tests
151
+
### Integration tests
119
152
120
-
- **`Linux.build` — runc non-zero exit:** build a package with a
121
-
broken `build:` command. Verify `exit_status != 0` and that the
122
-
overlay is fully cleaned up (no leaked mounts, no leftover rootfs).
123
-
- **`Linux.build` — overlay mount fails:** attempt overlay with an
124
-
invalid lower dir → `Error`, and no partial mount left behind.
125
-
Verify `mount` output is checked before proceeding.
126
-
- **`Linux.build` — runc not found:** set `PATH` to exclude runc,
127
-
attempt a build → clear error message, not a cryptic
128
-
`Unix_error(ENOENT)`.
129
-
- **`Linux.build` — cleanup after signal:** start a build, send
130
-
SIGTERM to the runc process mid-build. Verify that `runc delete`,
131
-
`umount`, and temp dir cleanup all still run. This is the Ctrl-C
132
-
recovery path.
133
-
- **`Docker` — docker not available:** attempt `debian` when docker
134
-
is not on `PATH` → clear error, not a hang.
153
+
`test/test_integration.ml` and `test/test_build_package.ml` require
154
+
Linux + runc + sudo + a statically-linked busybox. They're gated on
155
+
the environment variable:
135
156
136
-
### Fault injection
157
+
```
158
+
DAY11_INTEGRATION=true dune exec day11/container/test/test_integration.exe
159
+
```
137
160
138
-
The `CONTAINER` module type is a natural injection boundary. A
139
-
`Fist` (fault-injection) implementation can simulate failures
140
-
without runc, overlays, or sudo:
161
+
These actually mount overlays and run containers end to end. They
162
+
cover:
141
163
142
-
- **`Fist_container`:** a `CONTAINER` implementation where each
143
-
method's behavior is controlled by a mutable config table. Tests
144
-
set which packages should fail `build` (and with what exit code),
145
-
which should fail `generate_docs` (return `None`), how long
146
-
`build` takes (simulated via `Eio.Time.sleep`), etc. Hash
147
-
functions return deterministic test values.
148
-
- **Injected scenarios:**
149
-
- Package X fails with exit 1, package Y succeeds → verify
150
-
`build` library writes skeleton layers for X's dependents.
151
-
- `generate_docs` returns `None` for a specific package → verify
152
-
`build` records `Doc_failure` in layer.json.
153
-
- `generate_jtw` returns `None` → verify JTW layer is skipped
154
-
cleanly.
155
-
- `build` hangs (never returns) → verify the caller's timeout /
156
-
cancellation works.
157
-
- `init` fails → verify the error propagates before any builds
158
-
are attempted.
159
-
- **Benefits:** the `Fist_container` runs in the unit test tier
160
-
(no root, no runc, no Docker). This makes `build` and `batch`
161
-
testable on any CI runner.
164
+
- runc echo — smoke test
165
+
- overlay + runc — stack layers, read a file from a lower
166
+
- Hybrid lowerdir plan — exercises
167
+
`Day11_layer.Stack.plan_lowerdir` with varying dep counts
168
+
(pure multi-lower, forced split with small budget, 4K boundary)
169
+
and verifies every dep's file is visible inside the running
170
+
container
162
171
163
-
### Stub verification
164
-
165
-
- **`Freebsd` / `Windows` / `Dummy`** — verify they satisfy the
166
-
`CONTAINER` module type and raise/return appropriate "not supported"
167
-
values.
172
+
The unit tests are the always-on signal; the integration tests are
173
+
the "does this actually work against the kernel" verification that
174
+
runs on demand.
+57
-9
day11/container/mount.mli
+57
-9
day11/container/mount.mli
···
1
-
(** Mount specifications for OCI containers. *)
1
+
(** Mount point specifications for OCI containers.
2
+
3
+
A {!t} value describes a single entry in the container's
4
+
[mounts] array, exactly as it appears in the OCI runtime spec.
5
+
Values are constructed directly or via the {!bind_ro}/{!bind_rw}
6
+
helpers and collected into a list that is passed to
7
+
{!Oci_spec.make}.
8
+
9
+
The system mounts that every container needs ([/proc], [/sys],
10
+
[/dev/pts], etc.) are injected automatically by {!Oci_spec.make}
11
+
and should NOT appear in the caller's mount list — the caller is
12
+
only responsible for application-specific mounts, which in
13
+
practice means bind mounts. *)
2
14
3
15
type t = {
4
-
ty : string; (** Mount type: ["bind"], ["tmpfs"], ["proc"], etc. *)
5
-
src : string; (** Source path or filesystem type. *)
6
-
dst : string; (** Destination path inside the container. *)
7
-
options : string list; (** Mount options: ["ro"], ["nosuid"], etc. *)
16
+
ty : string;
17
+
(** Mount type as understood by the kernel: ["bind"], ["tmpfs"],
18
+
["proc"], ["sysfs"], ["cgroup"], ["devpts"], ["mqueue"], etc. *)
19
+
src : string;
20
+
(** Source of the mount. For bind mounts this is the absolute path
21
+
on the host filesystem; for virtual filesystems it is the
22
+
filesystem name (e.g. ["proc"], ["sysfs"]). *)
23
+
dst : string;
24
+
(** Absolute path inside the container where the mount appears. *)
25
+
options : string list;
26
+
(** Mount options as space-less strings: ["ro"], ["rw"], ["nosuid"],
27
+
["rbind"], ["rprivate"], ["size=65536k"], etc. *)
8
28
}
9
-
(** A single mount point specification. *)
29
+
(** One mount point. The field order mirrors the OCI runtime-spec
30
+
layout for convenience but does not affect behaviour. *)
10
31
11
32
val to_json : t -> Yojson.Safe.t
12
-
(** Serialize a mount to OCI-format JSON. *)
33
+
(** [to_json m] serializes [m] to the JSON object expected by the
34
+
OCI runtime spec:
35
+
36
+
{[
37
+
{ "destination": dst;
38
+
"type": ty;
39
+
"source": src;
40
+
"options": [...] }
41
+
]}
42
+
43
+
Normally called only by {!Oci_spec.make}; callers don't need to
44
+
touch the JSON form themselves. *)
45
+
46
+
(** {2 Bind-mount helpers}
47
+
48
+
Bind mounts make a host-side path visible inside the container at
49
+
a different (or the same) location. They are the main way the
50
+
build pipeline ships build inputs (opam-repository overlays,
51
+
patches, pre-built dependency trees) into a container.
52
+
53
+
Both helpers set [rbind] and [rprivate] so the mount is recursive
54
+
and does not propagate back to the host mount namespace. *)
13
55
14
56
val bind_ro : src:string -> string -> t
15
-
(** [bind_ro ~src dst] creates a read-only bind mount. *)
57
+
(** [bind_ro ~src dst] is a read-only bind mount of host path [src]
58
+
at container path [dst]. Use this for inputs the container should
59
+
not be able to modify: source archives, patch files, the
60
+
opam-repository, shared read-only dep trees, etc. *)
16
61
17
62
val bind_rw : src:string -> string -> t
18
-
(** [bind_rw ~src dst] creates a read-write bind mount. *)
63
+
(** [bind_rw ~src dst] is a read-write bind mount of host path [src]
64
+
at container path [dst]. Use this sparingly — the container will
65
+
be able to write to the host path directly. Typical uses are the
66
+
shared odoc-output directories during doc generation. *)
+12
-2
day11/container/oci_spec.ml
+12
-2
day11/container/oci_spec.ml
···
15
15
16
16
let strings xs = `List (List.map (fun x -> `String x) xs)
17
17
18
-
let make ~terminal ~root ~cwd ~argv ~hostname ~uid ~gid ~env ~mounts
19
-
~network =
18
+
let make ?(terminal = false) ?(cwd = "/") ?(hostname = "container")
19
+
?(env = []) ?(mounts = []) ?(network = false)
20
+
~root ~argv ~uid ~gid () =
20
21
`Assoc [
21
22
("ociVersion", `String "1.0.1-dev");
22
23
("process", `Assoc [
···
100
101
]);
101
102
]);
102
103
]
104
+
105
+
let write bundle_dir spec =
106
+
let path = Fpath.(bundle_dir / "config.json") in
107
+
try
108
+
Yojson.Safe.to_file (Fpath.to_string path) spec;
109
+
Ok ()
110
+
with exn ->
111
+
Rresult.R.error_msgf "Oci_spec.write %a: %s"
112
+
Fpath.pp path (Printexc.to_string exn)
+82
-18
day11/container/oci_spec.mli
+82
-18
day11/container/oci_spec.mli
···
1
-
(** OCI runtime specification generation.
1
+
(** OCI runtime specification (config.json) generation.
2
+
3
+
{{:https://github.com/opencontainers/runtime-spec}runc} and other
4
+
OCI runtimes read a bundle's [config.json] to decide everything
5
+
about how the container is launched: what to run, in what
6
+
rootfs, with what namespaces, capabilities, mounts, seccomp
7
+
filters, and so on.
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.
13
+
14
+
{1 Defaults}
2
15
3
-
Generates the JSON config passed to [runc run -b]. Includes Linux
4
-
namespaces, capabilities, seccomp filters, and standard system
5
-
mounts. This is pure JSON generation — no I/O. *)
16
+
Most of the OCI spec is boilerplate that never varies between
17
+
builds. {!make} hardcodes sensible values for all of it:
18
+
19
+
{ul
20
+
{- Linux namespaces: [pid], [ipc], [uts], [mount], and [network]
21
+
(unless [~network:true] is passed).}
22
+
{- Capabilities: a Docker-equivalent baseline (CAP_CHOWN,
23
+
CAP_DAC_OVERRIDE, CAP_FSETID, CAP_FOWNER, CAP_MKNOD,
24
+
CAP_SETGID, CAP_SETUID, CAP_SETFCAP, CAP_SETPCAP,
25
+
CAP_SYS_CHROOT, CAP_KILL, CAP_AUDIT_WRITE).}
26
+
{- Seccomp: [fsync], [fdatasync], [msync], [sync], [syncfs], and
27
+
[sync_file_range] are all masked to return [ERRNO 0]. This is
28
+
deliberate — it makes opam package installs significantly
29
+
faster because the build doesn't need durability guarantees
30
+
inside an ephemeral container.}
31
+
{- [rlimits]: [RLIMIT_NOFILE] = 1024.}
32
+
{- Standard system mounts: [/proc], [/sys], [/dev], [/dev/pts],
33
+
[/dev/shm], [/dev/mqueue], [/sys/fs/cgroup], and [/tmp].}
34
+
{- Masked and read-only [/proc] subpaths matching the Docker
35
+
defaults.}
36
+
{- If [~network:true]: a bind-mount of [/etc/resolv.conf] so
37
+
DNS works inside the container.}}
38
+
39
+
What varies per call is essentially: {e what to run, where, as
40
+
whom, and with which extra mounts}. *)
6
41
7
42
val make :
8
-
terminal:bool ->
43
+
?terminal:bool ->
44
+
?cwd:string ->
45
+
?hostname:string ->
46
+
?env:(string * string) list ->
47
+
?mounts:Mount.t list ->
48
+
?network:bool ->
9
49
root:string ->
10
-
cwd:string ->
11
50
argv:string list ->
12
-
hostname:string ->
13
51
uid:int ->
14
52
gid:int ->
15
-
env:(string * string) list ->
16
-
mounts:Mount.t list ->
17
-
network:bool ->
53
+
unit ->
18
54
Yojson.Safe.t
19
-
(** [make ~terminal ~root ~cwd ~argv ~hostname ~uid ~gid ~env ~mounts
20
-
~network] generates an OCI runtime spec.
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.
21
62
22
-
Includes:
23
-
- Linux namespaces: pid, ipc, uts, mount (+ network if [~network:false])
24
-
- Capabilities: Docker-default subset (CAP_CHOWN, CAP_DAC_OVERRIDE, etc.)
25
-
- Seccomp: fsync/fdatasync/msync/sync → ERRNO 0 (build performance)
26
-
- System mounts: proc, tmpfs, devpts, sysfs, cgroup, shm, mqueue
27
-
- If [~network:true]: bind-mounts [/etc/resolv.conf] for DNS *)
63
+
@param root Absolute host path of the container's rootfs
64
+
(typically the [target] of an {!Overlay.mount} call).
65
+
@param argv Command and arguments. First element is the
66
+
executable, the rest are passed to it unchanged.
67
+
@param uid User ID inside the container.
68
+
@param gid Group ID inside the container.
69
+
@param terminal Whether to allocate a controlling TTY. Default
70
+
[false] (build containers run non-interactively).
71
+
@param cwd Working directory inside the container. Default ["/"].
72
+
@param hostname Hostname visible inside the container. Default
73
+
["container"].
74
+
@param env Environment variables as [(key, value)] pairs. Default
75
+
[[]]. They are serialized as [KEY=value] strings.
76
+
@param mounts Extra bind mounts on top of the standard system
77
+
mounts (which are added automatically). Default [[]].
78
+
@param network If [true], the container joins the host network
79
+
namespace and gets [/etc/resolv.conf] bind-mounted. If [false]
80
+
(the default), the container is in its own network namespace
81
+
and has no connectivity.
82
+
@return A {!Yojson.Safe.t} [`Assoc] value. *)
83
+
84
+
val write :
85
+
Fpath.t ->
86
+
Yojson.Safe.t ->
87
+
(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. *)
+60
-9
day11/container/overlay.mli
+60
-9
day11/container/overlay.mli
···
1
-
(** Overlay filesystem assembly and teardown.
1
+
(** Linux overlayfs mount and umount.
2
+
3
+
Thin wrapper over the [mount(8)] and [umount(8)] commands that
4
+
requires [sudo]. The library supplies exactly the primitives
5
+
needed to stack build layers into a single rootfs for a
6
+
container run:
2
7
3
-
Manages Linux overlayfs mounts for layered container builds.
4
-
All operations require sudo. *)
8
+
{ul
9
+
{- {!mount} assembles an overlayfs from any number of
10
+
read-only lowers, one writable upper, and one workdir.}
11
+
{- {!umount} tears it down.}}
12
+
13
+
The mount is the final filesystem the container sees as [/]. The
14
+
upper dir captures everything the container writes; after the
15
+
run, the caller typically renames the upper into its cache as a
16
+
new layer. *)
5
17
6
18
val mount :
7
19
Eio_unix.Stdenv.base ->
···
10
22
work:Fpath.t ->
11
23
target:Fpath.t ->
12
24
(unit, [> Rresult.R.msg ]) result
13
-
(** [mount env ~lower ~upper ~work ~target] mounts an overlay filesystem.
14
-
[lower] is a list of read-only lower directories (first = bottom).
15
-
[upper] is the writable upper directory for new/changed files.
16
-
[work] is the overlay work directory (must be on same filesystem as upper).
17
-
[target] is the mount point. *)
25
+
(** [mount env ~lower ~upper ~work ~target] mounts an overlayfs at
26
+
[target] using the given lowers and upper.
27
+
28
+
{b Lower ordering follows kernel convention: the {e first} entry
29
+
in [lower] becomes the {e topmost} layer}, shadowing files from
30
+
later entries with the same path. The list is joined as
31
+
[lowerdir=A:B:C:...] and passed to [mount -t overlay], so the
32
+
same precedence rules as the [lowerdir] option apply:
33
+
34
+
{ul
35
+
{- Directories from all lowers are merged, union-style.}
36
+
{- For non-directory entries with the same name, the leftmost
37
+
layer wins.}
38
+
{- A [trusted.overlay.opaque=y] xattr on a directory in the
39
+
upper causes the corresponding directory in the lower to be
40
+
hidden (does not apply to directories in lowers themselves).}
41
+
{- A whiteout (char device 0/0) in a higher layer hides a
42
+
same-named entry in a lower layer.}}
43
+
44
+
The [upper] and [work] directories must exist and must be on the
45
+
same filesystem. The upper directory receives any writes the
46
+
container makes to its rootfs. The work directory is internal
47
+
overlayfs scratch space and should be treated as opaque — do not
48
+
read or write it directly.
49
+
50
+
Mount-option length limit: the classic [mount(2)] syscall caps
51
+
the options string at [PAGE_SIZE] (typically 4096 bytes). With
52
+
many lowers or long paths, this limit can be hit;
53
+
{!Day11_layer.Stack.plan_lowerdir} is the recommended way to
54
+
split a large dep list into a "kept separate" bucket and a
55
+
"cp-merged into one lower" bucket that fits the budget.
56
+
57
+
@param lower Read-only lowers, leftmost = topmost. Must be non-empty.
58
+
@param upper Writable upper directory (must be on the same
59
+
filesystem as [work]).
60
+
@param work Overlayfs workdir — scratch, do not touch.
61
+
@param target Mount point. Must already exist as an empty
62
+
directory.
63
+
@return [Ok ()] on success, or [Error (`Msg _)] if [mount] fails.
64
+
Common failure modes include a too-long options string, a
65
+
missing directory, or a permission error. *)
18
66
19
67
val umount :
20
68
Eio_unix.Stdenv.base ->
21
69
Fpath.t ->
22
70
(unit, [> Rresult.R.msg ]) result
23
-
(** [umount env target] unmounts the overlay at [target]. *)
71
+
(** [umount env target] unmounts the overlay previously mounted at
72
+
[target]. Safe to call on a directory that is not currently a
73
+
mount point — the error is returned but callers typically
74
+
[ignore] it inside cleanup handlers. *)
-9
day11/container/runc.ml
-9
day11/container/runc.ml
···
11
11
Bos.Cmd.(v "runc" % "delete" % "-f" % container_id)
12
12
in
13
13
Day11_exec.Sudo.run env cmd |> Result.map (fun _run -> ())
14
-
15
-
let write_spec bundle_dir spec =
16
-
let path = Fpath.(bundle_dir / "config.json") in
17
-
try
18
-
Yojson.Safe.to_file (Fpath.to_string path) spec;
19
-
Ok ()
20
-
with exn ->
21
-
Rresult.R.error_msgf "Runc.write_spec %a: %s"
22
-
Fpath.pp path (Printexc.to_string exn)
+42
-12
day11/container/runc.mli
+42
-12
day11/container/runc.mli
···
1
-
(** OCI container runtime (runc) execution.
1
+
(** OCI container runtime: running and deleting containers via [runc].
2
+
3
+
Thin wrapper over the [runc] command-line runtime. Both
4
+
functions require [sudo] (runc uses Linux clone/namespace
5
+
syscalls that need [CAP_SYS_ADMIN]).
2
6
3
-
Runs commands inside containers using the runc runtime.
4
-
All operations require sudo. *)
7
+
A container is identified by the pair of a {e bundle directory}
8
+
on disk and a {e container id} string. The bundle directory
9
+
must contain a [config.json] (OCI spec) and typically a
10
+
rootfs path referenced from that spec. Use
11
+
{!Oci_spec.make} + {!Oci_spec.write} to produce the config.
12
+
Container ids are caller-chosen but must be unique on the host
13
+
at the time of the [run] call — {!delete} cleans up any stale
14
+
container with the same id first. *)
5
15
6
16
val run :
7
17
Eio_unix.Stdenv.base ->
8
18
bundle:Fpath.t ->
9
19
container_id:string ->
10
20
(Day11_exec.Run.t, [> Rresult.R.msg ]) result
11
-
(** [run env ~bundle ~container_id] executes [sudo runc run -b bundle
12
-
container_id]. The bundle directory must contain a [config.json]
13
-
(OCI spec). Returns the run result on completion. *)
21
+
(** [run env ~bundle ~container_id] executes
22
+
[sudo runc run -b bundle container_id] and blocks until the
23
+
container exits.
24
+
25
+
{b Side effect:} runc's stdout and stderr are captured to
26
+
[bundle/runc.log]. Callers that need to inspect the output can
27
+
either read that file after the call returns, or use the
28
+
{!Day11_exec.Run.t} value, whose [output]/[errors] fields
29
+
contain the same data.
30
+
31
+
The returned {!Day11_exec.Run.t} carries the container's final
32
+
exit status in its [status] field: [`Exited n] for a normal
33
+
exit and [`Signaled n] if the container was killed by a signal.
34
+
A failed {e invocation} of runc itself (e.g. runc missing from
35
+
[$PATH]) returns [Error _]; a non-zero exit from a container
36
+
that ran to completion returns [Ok run] with a non-zero
37
+
[run.status]. Callers must distinguish the two.
38
+
39
+
This function does not clean up the container after it exits.
40
+
Always pair it with {!delete} inside a [Fun.protect] so that
41
+
exceptions don't leak container state into runc's on-disk
42
+
registry at [/run/runc/]. *)
14
43
15
44
val delete :
16
45
Eio_unix.Stdenv.base ->
17
46
string ->
18
47
(unit, [> Rresult.R.msg ]) result
19
-
(** [delete env container_id] forcefully deletes the container with
20
-
[sudo runc delete -f container_id]. *)
48
+
(** [delete env container_id] runs [sudo runc delete -f container_id]
49
+
to forcefully remove a container from runc's registry,
50
+
terminating it if it's still running. Safe to call on a
51
+
non-existent id — the error is returned and can be ignored.
21
52
22
-
val write_spec :
23
-
Fpath.t -> Yojson.Safe.t -> (unit, [> Rresult.R.msg ]) result
24
-
(** [write_spec bundle_dir spec] writes [spec] as [config.json] in
25
-
[bundle_dir]. *)
53
+
Callers typically [ignore] the result, both before a run
54
+
(to clear any stale state from a previous run that didn't
55
+
clean up) and after, inside a [Fun.protect] finally handler. *)
+1
-1
day11/container/test/dune
+1
-1
day11/container/test/dune
+23
-15
day11/container/test/test_build_package.ml
+23
-15
day11/container/test/test_build_package.ml
···
59
59
(* Generate OCI spec — run opam install with network for fetching *)
60
60
let spec =
61
61
Day11_container.Oci_spec.make
62
-
~terminal:false
63
-
~root:(Fpath.to_string merged)
64
62
~cwd:"/home/opam"
65
-
~argv:[ "/usr/bin/env"; "bash"; "-c";
66
-
Printf.sprintf "opam install -y %s" pkg ]
67
63
~hostname:"builder"
68
-
~uid ~gid
69
64
~env:[
70
65
("PATH", "/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin");
71
66
("HOME", "/home/opam");
···
74
69
("OPAMERRLOGLEN", "0");
75
70
("OPAMPRECISETRACKING", "1");
76
71
]
77
-
~mounts:[]
78
72
~network:true
73
+
~root:(Fpath.to_string merged)
74
+
~argv:[ "/usr/bin/env"; "bash"; "-c";
75
+
Printf.sprintf "opam install -y %s" pkg ]
76
+
~uid ~gid
77
+
()
79
78
in
80
-
Day11_container.Runc.write_spec temp_dir spec
79
+
Day11_container.Oci_spec.write temp_dir spec
81
80
|> ok_or_fail "write spec";
82
81
let container_id =
83
82
Printf.sprintf "day11-build-%s-%d" pkg (Unix.getpid ())
···
108
107
% Fpath.to_string Fpath.(layer_dir / "fs")) in
109
108
(match r with Ok _ -> () | Error (`Msg e) -> Alcotest.fail e);
110
109
(* Write layer.json *)
111
-
let meta : Day11_layer.Layer_meta.build_meta = {
112
-
package = pkg; kind = Day11_layer.Layer_meta.Build;
110
+
let meta : Day11_layer.Meta.t = {
113
111
exit_status = exit_code;
114
-
deps = []; hashes = [];
112
+
parent_hashes = [];
115
113
uid = 1000; gid = 1000;
116
114
base_hash = Day11_layer.Hash.base_hash ~image:base_image;
117
-
installed_libs = []; installed_docs = []; patches = [];
118
-
failed_dep = None; disk_usage = 0;
119
-
timing = Day11_layer.Layer_meta.empty_timing;
115
+
disk_usage = 0;
116
+
timing = Day11_layer.Meta.empty_timing;
120
117
created_at = "";
118
+
failed_dep = None;
121
119
} in
122
-
Day11_layer.Layer_meta.save_build
120
+
Day11_layer.Meta.save
123
121
Fpath.(layer_dir / "layer.json") meta
124
122
|> ok_or_fail "save layer meta";
123
+
(* Write build.json sidecar *)
124
+
let bm : Day11_opam_layer.Build_meta.t = {
125
+
package = pkg;
126
+
deps = [];
127
+
installed_libs = [];
128
+
installed_docs = [];
129
+
patches = [];
130
+
} in
131
+
Day11_opam_layer.Build_meta.save layer_dir bm
132
+
|> ok_or_fail "save build meta";
125
133
(* Clean up temp dir *)
126
134
Day11_exec.Sudo.rm_rf env temp_dir |> ignore;
127
135
Printf.printf "Layer for %s at %s\n%!" pkg (Fpath.to_string layer_dir);
···
157
165
let _ = Day11_exec.Sudo.run env
158
166
Bos.Cmd.(v "chmod" % "-R" % "a+rX"
159
167
% Fpath.to_string Fpath.(astring_layer / "fs")) in
160
-
let installed = Day11_layer.Installed_files.scan_libs
168
+
let installed = Day11_opam_layer.Installed_files.scan_libs
161
169
~layer_dir:astring_layer in
162
170
Printf.printf "Installed lib files after chmod: %d\n%!" (List.length installed);
163
171
List.iter (fun f -> Printf.printf " %s\n%!" f)
+15
-17
day11/container/test/test_container.ml
+15
-17
day11/container/test/test_container.ml
···
62
62
63
63
let make_basic_spec ?(network = false) () =
64
64
Oci_spec.make
65
-
~terminal:false
66
-
~root:"/rootfs"
67
65
~cwd:"/home/opam"
68
-
~argv:[ "sh"; "-c"; "echo hello" ]
69
66
~hostname:"builder"
70
-
~uid:1000 ~gid:1000
71
67
~env:[ ("PATH", "/usr/bin"); ("HOME", "/home/opam") ]
72
-
~mounts:[]
73
68
~network
69
+
~root:"/rootfs"
70
+
~argv:[ "sh"; "-c"; "echo hello" ]
71
+
~uid:1000 ~gid:1000
72
+
()
74
73
75
74
let test_oci_spec_basic () =
76
75
let spec = make_basic_spec () in
···
162
161
let user_mount = Mount.bind_ro ~src:"/host/repo" "/opam-repo" in
163
162
let spec =
164
163
Oci_spec.make
165
-
~terminal:false ~root:"/rootfs" ~cwd:"/" ~argv:[ "true" ]
166
-
~hostname:"test" ~uid:0 ~gid:0 ~env:[]
167
-
~mounts:[ user_mount ] ~network:false
164
+
~hostname:"test" ~mounts:[ user_mount ]
165
+
~root:"/rootfs" ~argv:[ "true" ]
166
+
~uid:0 ~gid:0
167
+
()
168
168
in
169
169
let mounts = spec |> json_member "mounts" |> json_to_list in
170
170
let mount_dsts = List.map (fun m ->
···
190
190
let test_oci_spec_terminal () =
191
191
let spec =
192
192
Oci_spec.make
193
-
~terminal:true ~root:"/rootfs" ~cwd:"/" ~argv:[ "/bin/bash" ]
194
-
~hostname:"debug" ~uid:1000 ~gid:1000 ~env:[]
195
-
~mounts:[] ~network:true
193
+
~terminal:true ~hostname:"debug" ~network:true
194
+
~root:"/rootfs" ~argv:[ "/bin/bash" ]
195
+
~uid:1000 ~gid:1000
196
+
()
196
197
in
197
198
let process = json_member "process" spec in
198
199
Alcotest.(check bool) "terminal true"
199
200
true (process |> json_member "terminal" |> json_to_bool)
200
201
201
-
(* ── Runc.write_spec tests ───────────────────────────────────────── *)
202
+
(* ── Oci_spec.write tests ────────────────────────────────────────── *)
202
203
203
204
let test_write_spec () = with_tmp_dir @@ fun dir ->
204
205
let spec = make_basic_spec () in
205
-
Runc.write_spec dir spec |> is_ok "write_spec";
206
+
Oci_spec.write dir spec |> is_ok "write";
206
207
let config_path = Fpath.(dir / "config.json") in
207
208
Alcotest.(check bool) "config.json exists"
208
209
true (Bos.OS.File.exists config_path |> Result.get_ok);
···
237
238
Alcotest.test_case "capabilities" `Quick
238
239
test_oci_spec_capabilities;
239
240
Alcotest.test_case "terminal" `Quick test_oci_spec_terminal;
240
-
] );
241
-
( "Runc",
242
-
[
243
-
Alcotest.test_case "write_spec" `Quick test_write_spec;
241
+
Alcotest.test_case "write" `Quick test_write_spec;
244
242
] );
245
243
]
+12
-21
day11/container/test/test_integration.ml
+12
-21
day11/container/test/test_integration.ml
···
42
42
(* Generate OCI spec *)
43
43
let spec =
44
44
Oci_spec.make
45
-
~terminal:false
45
+
~hostname:"test"
46
+
~env:[ ("PATH", "/bin") ]
46
47
~root:(Fpath.to_string rootfs)
47
-
~cwd:"/"
48
48
~argv:[ "/bin/echo"; "hello from container" ]
49
-
~hostname:"test"
50
49
~uid:0 ~gid:0
51
-
~env:[ ("PATH", "/bin") ]
52
-
~mounts:[]
53
-
~network:false
50
+
()
54
51
in
55
-
Runc.write_spec dir spec |> ok_or_fail "write_spec";
52
+
Oci_spec.write dir spec |> ok_or_fail "write_spec";
56
53
(* Run it *)
57
54
let container_id = "day11-test-" ^ string_of_int (Unix.getpid ()) in
58
55
(* Clean up any stale container *)
···
100
97
(* Generate OCI spec using the overlay as rootfs *)
101
98
let spec =
102
99
Oci_spec.make
103
-
~terminal:false
100
+
~hostname:"test"
101
+
~env:[ ("PATH", "/bin") ]
104
102
~root:(Fpath.to_string merged)
105
-
~cwd:"/"
106
103
~argv:[ "/bin/cat"; "/etc/greeting" ]
107
-
~hostname:"test"
108
104
~uid:0 ~gid:0
109
-
~env:[ ("PATH", "/bin") ]
110
-
~mounts:[]
111
-
~network:false
105
+
()
112
106
in
113
-
Runc.write_spec dir spec |> ok_or_fail "write_spec";
107
+
Oci_spec.write dir spec |> ok_or_fail "write_spec";
114
108
let container_id = "day11-overlay-" ^ string_of_int (Unix.getpid ()) in
115
109
ignore (Runc.delete env container_id);
116
110
let run =
···
222
216
in
223
217
let spec =
224
218
Oci_spec.make
225
-
~terminal:false
219
+
~hostname:"test"
220
+
~env:[ ("PATH", "/bin") ]
226
221
~root:(Fpath.to_string merged)
227
-
~cwd:"/"
228
222
~argv:[ "/bin/sh"; "-c"; script ]
229
-
~hostname:"test"
230
223
~uid:0 ~gid:0
231
-
~env:[ ("PATH", "/bin") ]
232
-
~mounts:[]
233
-
~network:false
224
+
()
234
225
in
235
-
Runc.write_spec dir spec |> ok_or_fail "write_spec";
226
+
Oci_spec.write dir spec |> ok_or_fail "write_spec";
236
227
let container_id =
237
228
Printf.sprintf "day11-hybrid-%d-%d" n_layers (Unix.getpid ()) in
238
229
ignore (Runc.delete env container_id);
+2
-2
day11/doc/dune
+2
-2
day11/doc/dune
···
1
1
(library
2
2
(name day11_doc)
3
-
(libraries astring day11_batch day11_build day11_container day11_exec day11_graph
4
-
day11_layer day11_lib
3
+
(libraries astring day11_batch day11_build day11_container day11_doc_layer
4
+
day11_exec day11_graph day11_layer day11_lib day11_opam_layer
5
5
bos fpath opam-format rresult yojson unix))
+50
-19
day11/doc/generate.ml
+50
-19
day11/doc/generate.ml
···
1
-
open Day11_layer.Layer_type
1
+
open Day11_opam_layer
2
+
module Build = Day11_opam_layer.Build
3
+
module Tool = Day11_opam_layer.Tool
4
+
module Doc_meta = Day11_doc_layer.Doc_meta
5
+
6
+
(* Local aliases so the existing code reads naturally. *)
7
+
type build = Build.t
8
+
type tool = Tool.t
2
9
3
10
let concrete_compiler_names = List.map OpamPackage.Name.of_string
4
11
[ "ocaml-base-compiler"; "ocaml-variants"; "ocaml-system" ]
···
17
24
let extract_bin ~os_dir tool_builds name =
18
25
let switch = Day11_build.Types.switch in
19
26
List.find_map (fun (bl : build) ->
20
-
let bin = Fpath.(build_dir ~os_dir bl / "fs" / "home" / "opam"
27
+
let bin = Fpath.(Build.dir ~os_dir bl / "fs" / "home" / "opam"
21
28
/ ".opam" / switch / "bin" / name) in
22
29
if Bos.OS.File.exists bin |> Result.get_ok then Some bin
23
30
else None
···
47
54
48
55
(** Collect transitive build dep hashes into a seen set. *)
49
56
let collect_transitive_deps (seen : (string, unit) Hashtbl.t)
50
-
(node : Day11_layer.Layer_type.build) =
51
-
let rec walk (n : Day11_layer.Layer_type.build) =
57
+
(node : Build.t) =
58
+
let rec walk (n : Build.t) =
52
59
if not (Hashtbl.mem seen n.hash) then begin
53
60
Hashtbl.replace seen n.hash ();
54
61
List.iter walk n.deps
···
60
67
(** Prepare mounts and metadata for a doc container.
61
68
Returns None if the package has no installed libs or no matching
62
69
odoc tool. Caller must clean up [prep_dir] after use. *)
63
-
let prepare_package ~os_dir ~driver_tool ~odoc_tools:_ ~build_hash_blessed
70
+
let prepare_package ~os_dir ~(driver_tool : Tool.t) ~odoc_tools:_ ~build_hash_blessed
64
71
~find_odoc_tool (node : build) =
65
-
let pkg_dir = build_dir ~os_dir node in
66
-
let installed_libs = Day11_layer.Installed_files.scan_libs
72
+
let pkg_dir = Build.dir ~os_dir node in
73
+
let installed_libs = Installed_files.scan_libs
67
74
~layer_dir:pkg_dir in
68
75
if installed_libs = [] then None
69
76
else match find_odoc_tool node.pkg with
70
77
| None -> None
71
-
| Some odoc_tool ->
72
-
let installed_docs = Day11_layer.Installed_files.scan_docs
78
+
| Some (odoc_tool : Tool.t) ->
79
+
let installed_docs = Installed_files.scan_docs
73
80
~layer_dir:pkg_dir in
74
81
let composite_tool_hash = Day11_layer.Hash.of_strings
75
82
[ driver_tool.hash; odoc_tool.hash ] in
···
114
121
[ "compile"; node.hash; composite_tool_hash ] in
115
122
let compile_node : build =
116
123
{ hash; pkg = node.pkg; deps = [ node ]; universe = Day11_graph.Universe.dummy } in
124
+
let on_extract ~layer_dir ~success:_ =
125
+
let dm : Doc_meta.t = {
126
+
package = OpamPackage.to_string node.pkg;
127
+
phase = Doc_meta.Compile;
128
+
deps = List.map (fun (d : build) -> OpamPackage.to_string d.pkg) compile_node.deps;
129
+
} in
130
+
ignore (Doc_meta.save layer_dir dm)
131
+
in
117
132
let result =
118
133
match Day11_build.Build_layer.build env benv
119
134
~mounts:(mounts @ store_mounts) ~skip_state_dump:true
120
-
~kind:Day11_layer.Layer_meta.Compile
135
+
~on_extract
121
136
compile_node
122
137
~strategy:{ cmd; cleanup = doc_cleanup } () with
123
138
| Day11_build.Types.Success bl ->
···
168
183
let link_node : build =
169
184
{ hash; pkg = node.pkg;
170
185
deps = [ node; compile_bl ] @ dep_compile_layers; universe = Day11_graph.Universe.dummy } in
186
+
let on_extract ~layer_dir ~success:_ =
187
+
let dm : Doc_meta.t = {
188
+
package = OpamPackage.to_string node.pkg;
189
+
phase = Doc_meta.Link;
190
+
deps = List.map (fun (d : build) -> OpamPackage.to_string d.pkg) link_node.deps;
191
+
} in
192
+
ignore (Doc_meta.save layer_dir dm)
193
+
in
171
194
let result =
172
195
match Day11_build.Build_layer.build env benv
173
196
~mounts:(mounts @ store_mounts) ~skip_state_dump:true
174
-
~kind:Day11_layer.Layer_meta.Link
197
+
~on_extract
175
198
link_node
176
199
~strategy:{ cmd; cleanup = doc_cleanup } () with
177
200
| Day11_build.Types.Success _bl ->
···
220
243
let doc_node : build =
221
244
{ hash; pkg = node.pkg;
222
245
deps = [ node ] @ dep_compile_layers; universe = Day11_graph.Universe.dummy } in
246
+
let on_extract ~layer_dir ~success:_ =
247
+
let dm : Doc_meta.t = {
248
+
package = OpamPackage.to_string node.pkg;
249
+
phase = Doc_meta.Doc_all;
250
+
deps = List.map (fun (d : build) -> OpamPackage.to_string d.pkg) doc_node.deps;
251
+
} in
252
+
ignore (Doc_meta.save layer_dir dm)
253
+
in
223
254
let result =
224
255
match Day11_build.Build_layer.build env benv
225
256
~mounts:(mounts @ store_mounts) ~skip_state_dump:true
226
-
~kind:Day11_layer.Layer_meta.Doc_all
257
+
~on_extract
227
258
doc_node
228
259
~strategy:{ cmd; cleanup = doc_cleanup } () with
229
260
| Day11_build.Types.Success bl ->
···
240
271
ignore (Day11_exec.Sudo.rm_rf env prep_dir);
241
272
result
242
273
243
-
let run env benv ~np ~os_dir ~driver_tool ~odoc_tools
274
+
let run env benv ~np ~os_dir ~(driver_tool : Tool.t) ~odoc_tools
244
275
~tool_source_dirs ~mounts
245
276
~packages ~opam_env ~run_log
246
277
~build_one ~nodes ~solutions ~blessing_maps:_ =
···
257
288
) builds
258
289
in
259
290
add_nodes driver_tool.builds;
260
-
List.iter (fun (_, tool) -> add_nodes tool.builds) odoc_tools;
291
+
List.iter (fun (_, (tool : Tool.t)) -> add_nodes tool.builds) odoc_tools;
261
292
Hashtbl.fold (fun _ n acc -> n :: acc) seen []
262
293
in
263
294
(* Find the final build node for each tool *)
264
295
let driver_final = List.find (fun (n : build) ->
265
296
String.equal n.hash driver_tool.hash) driver_tool.builds in
266
-
let odoc_finals = List.map (fun (compiler, tool) ->
297
+
let odoc_finals = List.map (fun (compiler, (tool : Tool.t)) ->
267
298
let final = List.find (fun (n : build) ->
268
299
String.equal n.hash tool.hash) tool.builds in
269
300
(compiler, tool, final)
···
590
621
Hashtbl.replace dep_locs build_hash loc
591
622
) node_pkg_loc;
592
623
let is_cached node =
593
-
let layer_dir = Day11_layer.Layer_type.build_dir ~os_dir node in
624
+
let layer_dir = Day11_opam_layer.Build.dir ~os_dir node in
594
625
let layer_cached =
595
626
Bos.OS.File.exists Fpath.(layer_dir / "layer.json")
596
627
|> Result.get_ok
···
624
655
else "build"
625
656
in
626
657
let layer = Fpath.to_string
627
-
(Day11_layer.Layer_type.build_dir ~os_dir node) in
658
+
(Day11_opam_layer.Build.dir ~os_dir node) in
628
659
Day11_lib.Run_log.log_build_result run_log
629
660
~pkg:(OpamPackage.to_string node.pkg)
630
661
~hash:node.hash ~status ~failed_dep:None
···
717
748
HTML count only from this run (cached in atomics). *)
718
749
let total_doc_count = ref 0 in
719
750
let count_success node =
720
-
let dd = build_dir ~os_dir node in
751
+
let dd = Build.dir ~os_dir node in
721
752
let layer_json = Fpath.(dd / "layer.json") in
722
753
if Bos.OS.File.exists layer_json |> Result.get_ok then
723
-
match Day11_layer.Layer_meta.load_build layer_json with
754
+
match Day11_layer.Meta.load layer_json with
724
755
| Ok meta when meta.exit_status = 0 -> incr total_doc_count
725
756
| _ -> ()
726
757
in
+6
-6
day11/doc/generate.mli
+6
-6
day11/doc/generate.mli
···
35
35
Day11_build.Types.build_env ->
36
36
np:int ->
37
37
os_dir:Fpath.t ->
38
-
driver_tool:Day11_layer.Layer_type.tool ->
39
-
odoc_tools:(OpamPackage.t * Day11_layer.Layer_type.tool) list ->
38
+
driver_tool:Day11_opam_layer.Tool.t ->
39
+
odoc_tools:(OpamPackage.t * Day11_opam_layer.Tool.t) list ->
40
40
tool_source_dirs:string OpamPackage.Name.Map.t ->
41
41
mounts:Day11_container.Mount.t list ->
42
42
packages:Day11_opam.Git_packages.t ->
43
43
opam_env:(string -> OpamVariable.variable_contents option) ->
44
44
run_log:Day11_lib.Run_log.t ->
45
-
build_one:(Day11_layer.Layer_type.build -> bool) ->
46
-
nodes:Day11_layer.Layer_type.build list ->
45
+
build_one:(Day11_opam_layer.Build.t -> bool) ->
46
+
nodes:Day11_opam_layer.Build.t list ->
47
47
solutions:(OpamPackage.t * Day11_graph.Graph.solution) list ->
48
48
blessing_maps:(OpamPackage.t * bool OpamPackage.Map.t) list ->
49
49
int * int
···
59
59
mounts:Day11_container.Mount.t list ->
60
60
driver_compiler:OpamPackage.t ->
61
61
odoc_repo:string option ->
62
-
build_one:(Day11_layer.Layer_type.build -> bool) ->
62
+
build_one:(Day11_opam_layer.Build.t -> bool) ->
63
63
opam_repositories:string list ->
64
64
cache:Day11_build.Hash_cache.t ->
65
65
run_log:Day11_lib.Run_log.t ->
66
-
nodes:Day11_layer.Layer_type.build list ->
66
+
nodes:Day11_opam_layer.Build.t list ->
67
67
solutions:(OpamPackage.t * Day11_graph.Graph.solution) list ->
68
68
blessing_maps:(OpamPackage.t * bool OpamPackage.Map.t) list ->
69
69
unit
+10
-8
day11/doc/test/test_doc_compile_link.ml
+10
-8
day11/doc/test/test_doc_compile_link.ml
···
8
8
dune exec day11/doc/test/test_doc_compile_link.exe *)
9
9
10
10
open Day11_build
11
-
open Day11_layer.Layer_type
11
+
module Build = Day11_opam_layer.Build
12
+
module Tool = Day11_opam_layer.Tool
13
+
type build = Build.t
12
14
open Day11_test_util.Test_util
13
15
14
16
let scratch_cache_dir = Fpath.v "/tmp/day11-scratch-cache"
···
19
21
Day11_doc.Tool_binaries.doc_tool_mounts odoc_tool in
20
22
(* odoc_driver_voodoo is also bind-mounted *)
21
23
let voodoo_bin = "/home/opam/doc-tools/bin/odoc_driver_voodoo" in
22
-
let pkg_dir = build_dir ~os_dir pkg_build in
23
-
let installed_libs = Day11_layer.Installed_files.scan_libs
24
+
let pkg_dir = Build.dir ~os_dir pkg_build in
25
+
let installed_libs = Day11_opam_layer.Installed_files.scan_libs
24
26
~layer_dir:pkg_dir in
25
-
let installed_docs = Day11_layer.Installed_files.scan_docs
27
+
let installed_docs = Day11_opam_layer.Installed_files.scan_docs
26
28
~layer_dir:pkg_dir in
27
29
let universe = Day11_doc.Command.compute_universe_hash
28
30
(List.map (fun (b : build) -> b.hash) odoc_tool.builds) in
···
66
68
compile_node ~strategy:{ cmd = compile_cmd; cleanup = fun _ _ -> () } ()
67
69
with
68
70
| Types.Success bl ->
69
-
let cd = build_dir ~os_dir bl in
71
+
let cd = Build.dir ~os_dir bl in
70
72
let find_run = Day11_exec.Run.run env
71
73
Bos.Cmd.(v "find" % Fpath.to_string Fpath.(cd / "fs")
72
74
% "-name" % "*.odoc" % "-type" % "f") None in
···
75
77
Printf.printf " compile: %d .odoc files\n%!" n;
76
78
bl
77
79
| Types.Failure name ->
78
-
let log = Fpath.(build_dir ~os_dir compile_node / "layer.log") in
80
+
let log = Fpath.(Build.dir ~os_dir compile_node / "layer.log") in
79
81
(match Bos.OS.File.read log with
80
82
| Ok s -> Printf.printf "COMPILE LOG:\n%s\n%!" s | Error _ -> ());
81
83
Alcotest.fail ("compile failed: " ^ name)
···
93
95
link_node ~strategy:{ cmd = link_cmd; cleanup = fun _ _ -> () } ()
94
96
with
95
97
| Types.Success bl ->
96
-
let ld = build_dir ~os_dir bl in
98
+
let ld = Build.dir ~os_dir bl in
97
99
let find_run = Day11_exec.Run.run env
98
100
Bos.Cmd.(v "find" % Fpath.to_string Fpath.(ld / "fs")
99
101
% "-name" % "*.html" % "-type" % "f") None in
···
102
104
Printf.printf " link: %d HTML files\n%!" (List.length files);
103
105
List.length files
104
106
| Types.Failure name ->
105
-
let log = Fpath.(build_dir ~os_dir link_node / "layer.log") in
107
+
let log = Fpath.(Build.dir ~os_dir link_node / "layer.log") in
106
108
(match Bos.OS.File.read log with
107
109
| Ok s -> Printf.printf "LINK LOG:\n%s\n%!" s | Error _ -> ());
108
110
Alcotest.fail ("link failed: " ^ name)
+3
-3
day11/doc/test/test_doc_integration.ml
+3
-3
day11/doc/test/test_doc_integration.ml
···
12
12
let packages_dir = Fpath.(os_dir / "packages")
13
13
let base_dir = Fpath.(cache_dir / "base")
14
14
let switch = "default"
15
-
let make_base () : Day11_layer.Layer_type.base =
15
+
let make_base () : Day11_layer.Base.t =
16
16
{ hash = Day11_build.Base.build_hash ~os_distribution:"debian"
17
17
~os_version:"bookworm" ~arch:"x86_64";
18
18
dir = base_dir;
···
35
35
| None -> Alcotest.skip ()
36
36
in
37
37
let astring_layer = Fpath.(os_dir / astring_layer_name) in
38
-
let installed_libs = Day11_layer.Installed_files.scan_libs
38
+
let installed_libs = Day11_opam_layer.Installed_files.scan_libs
39
39
~layer_dir:astring_layer in
40
-
let installed_docs = Day11_layer.Installed_files.scan_docs
40
+
let installed_docs = Day11_opam_layer.Installed_files.scan_docs
41
41
~layer_dir:astring_layer in
42
42
let dest_dir = Bos.OS.Dir.tmp "day11_doc_prep_%s" |> Result.get_ok in
43
43
Fun.protect ~finally:(fun () ->
+14
-12
day11/doc/test/test_doc_pipeline.ml
+14
-12
day11/doc/test/test_doc_pipeline.ml
···
8
8
dune exec day11/doc/test/test_doc_pipeline.exe *)
9
9
10
10
open Day11_build
11
-
open Day11_layer.Layer_type
11
+
module Build = Day11_opam_layer.Build
12
+
module Tool = Day11_opam_layer.Tool
13
+
type build = Build.t
12
14
open Day11_test_util.Test_util
13
15
14
16
let scratch_cache_dir = Fpath.v "/tmp/day11-scratch-cache"
···
50
52
let doc_all_html = ref 0 in
51
53
Printf.printf "\nGenerating docs (single phase)...\n%!";
52
54
List.iter (fun (b : build) ->
53
-
let pkg_dir = build_dir ~os_dir b in
54
-
let installed_libs = Day11_layer.Installed_files.scan_libs
55
+
let pkg_dir = Build.dir ~os_dir b in
56
+
let installed_libs = Day11_opam_layer.Installed_files.scan_libs
55
57
~layer_dir:pkg_dir in
56
58
if installed_libs = [] then
57
59
Printf.printf " %s: no libs, skipping\n%!"
58
60
(OpamPackage.to_string b.pkg)
59
61
else begin
60
-
let installed_docs = Day11_layer.Installed_files.scan_docs
62
+
let installed_docs = Day11_opam_layer.Installed_files.scan_docs
61
63
~layer_dir:pkg_dir in
62
64
let prep_dir = Bos.OS.Dir.tmp "day11_doc_%s" |> Result.get_ok in
63
65
ignore (Day11_doc.Prep.create_with_mounts ~source_layer_dir:pkg_dir
···
79
81
(match Build_layer.build env benv ~mounts:[ prep_mount ]
80
82
doc_node ~strategy:{ cmd; cleanup = fun _ _ -> () } () with
81
83
| Types.Success bl ->
82
-
let dd = build_dir ~os_dir bl in
84
+
let dd = Build.dir ~os_dir bl in
83
85
let find_run = Day11_exec.Run.run env
84
86
Bos.Cmd.(v "find" % Fpath.to_string Fpath.(dd / "fs")
85
87
% "-name" % "*.html" % "-type" % "f") None in
···
101
103
(* Step 4: Compile phase for split packages *)
102
104
Printf.printf "\nGenerating docs (split phase — compile)...\n%!";
103
105
let compile_builds = List.filter_map (fun (b : build) ->
104
-
let pkg_dir = build_dir ~os_dir b in
105
-
let installed_libs = Day11_layer.Installed_files.scan_libs
106
+
let pkg_dir = Build.dir ~os_dir b in
107
+
let installed_libs = Day11_opam_layer.Installed_files.scan_libs
106
108
~layer_dir:pkg_dir in
107
109
if installed_libs = [] then None
108
110
else begin
109
-
let installed_docs = Day11_layer.Installed_files.scan_docs
111
+
let installed_docs = Day11_opam_layer.Installed_files.scan_docs
110
112
~layer_dir:pkg_dir in
111
113
let prep_dir = Bos.OS.Dir.tmp "day11_doc_%s" |> Result.get_ok in
112
114
ignore (Day11_doc.Prep.create_with_mounts ~source_layer_dir:pkg_dir
···
146
148
Printf.printf "\nGenerating docs (split phase — link)...\n%!";
147
149
let split_html = ref 0 in
148
150
List.iter (fun ((b : build), (compile_bl : build)) ->
149
-
let pkg_dir = build_dir ~os_dir b in
150
-
let installed_libs = Day11_layer.Installed_files.scan_libs
151
+
let pkg_dir = Build.dir ~os_dir b in
152
+
let installed_libs = Day11_opam_layer.Installed_files.scan_libs
151
153
~layer_dir:pkg_dir in
152
-
let installed_docs = Day11_layer.Installed_files.scan_docs
154
+
let installed_docs = Day11_opam_layer.Installed_files.scan_docs
153
155
~layer_dir:pkg_dir in
154
156
let prep_dir = Bos.OS.Dir.tmp "day11_doc_%s" |> Result.get_ok in
155
157
ignore (Day11_doc.Prep.create_with_mounts ~source_layer_dir:pkg_dir
···
172
174
(match Build_layer.build env benv ~mounts:[ prep_mount ]
173
175
link_node ~strategy:{ cmd; cleanup = fun _ _ -> () } () with
174
176
| Types.Success bl ->
175
-
let dd = build_dir ~os_dir bl in
177
+
let dd = Build.dir ~os_dir bl in
176
178
let find_run = Day11_exec.Run.run env
177
179
Bos.Cmd.(v "find" % Fpath.to_string Fpath.(dd / "fs")
178
180
% "-name" % "*.html" % "-type" % "f") None in
+10
-8
day11/doc/test/test_generate_docs.ml
+10
-8
day11/doc/test/test_generate_docs.ml
···
10
10
let _packages_dir = Fpath.(os_dir / "packages")
11
11
let base_dir = Fpath.(cache_dir / "base")
12
12
let _switch = "default"
13
-
let make_base () : Day11_layer.Layer_type.base =
13
+
let make_base () : Day11_layer.Base.t =
14
14
{ hash = Day11_build.Base.build_hash ~os_distribution:"debian"
15
15
~os_version:"bookworm" ~arch:"x86_64";
16
16
dir = base_dir;
···
46
46
let astring_layer_hash =
47
47
Day11_build.Hash_cache.layer_hash cache ~base_hash:base.hash
48
48
[ astring_pkg ] in
49
-
let astring_node : Day11_layer.Layer_type.build =
49
+
let astring_node : Day11_opam_layer.Build.t =
50
50
{ hash = astring_layer_hash; pkg = astring_pkg;
51
51
deps = driver_tool.builds; universe = Day11_graph.Universe.dummy } in
52
52
let astring_result =
···
58
58
Printf.printf "astring: %s\n%!" bl.hash
59
59
| _ -> Alcotest.fail "astring build failed");
60
60
(* Step 3: Create prep structure *)
61
-
let astring_layer = Day11_layer.Layer_type.build_dir ~os_dir astring_node in
61
+
let astring_layer = Day11_opam_layer.Build.dir ~os_dir astring_node in
62
62
let _ = Day11_exec.Sudo.run env
63
63
Bos.Cmd.(v "chmod" % "-R" % "a+rX"
64
64
% Fpath.to_string Fpath.(astring_layer / "fs")) in
65
-
let installed_libs = Day11_layer.Installed_files.scan_libs
65
+
let installed_libs = Day11_opam_layer.Installed_files.scan_libs
66
66
~layer_dir:astring_layer in
67
-
let installed_docs = Day11_layer.Installed_files.scan_docs
67
+
let installed_docs = Day11_opam_layer.Installed_files.scan_docs
68
68
~layer_dir:astring_layer in
69
69
let prep_dir = Bos.OS.Dir.tmp "day11_prep_%s" |> Result.get_ok in
70
70
let _prep_root =
···
93
93
"/home/opam/prep";
94
94
] in
95
95
let build_dirs = List.map
96
-
(Day11_layer.Layer_type.build_dir ~os_dir) all_builds in
96
+
(Day11_opam_layer.Build.dir ~os_dir) all_builds in
97
+
let benv = Day11_build.Types.make_build_env
98
+
~base ~os_dir ~uid:1000 ~gid:1000 () in
97
99
let run, upper, _timing =
98
-
Day11_build.Run_in_layers.run env ~base ~build_dirs
99
-
~uid:1000 ~gid:1000 ~mounts voodoo_cmd
100
+
Day11_build.Run_in_layers.run env benv ~build_dirs
101
+
~mounts voodoo_cmd
100
102
|> ok_or_fail "run voodoo"
101
103
in
102
104
Fun.protect
+4
-4
day11/doc/tool_binaries.ml
+4
-4
day11/doc/tool_binaries.ml
···
1
1
let switch = "default"
2
2
3
-
let find_binary (tool : Day11_layer.Layer_type.tool) name =
3
+
let find_binary (tool : Day11_opam_layer.Tool.t) name =
4
4
let path = Fpath.(tool.dir / "fs" / "home" / "opam" / ".opam"
5
5
/ switch / "bin" / name) in
6
6
if Bos.OS.File.exists path |> Result.get_ok then Some path
7
7
else
8
8
(* Try searching across all build layers *)
9
-
List.find_map (fun (b : Day11_layer.Layer_type.build) ->
9
+
List.find_map (fun (b : Day11_opam_layer.Build.t) ->
10
10
let os_dir = Fpath.parent tool.dir in
11
-
let build_dir = Day11_layer.Layer_type.build_dir ~os_dir b in
12
-
let p = Fpath.(build_dir / "fs" / "home" / "opam" / ".opam"
11
+
let bdir = Day11_opam_layer.Build.dir ~os_dir b in
12
+
let p = Fpath.(bdir / "fs" / "home" / "opam" / ".opam"
13
13
/ switch / "bin" / name) in
14
14
if Bos.OS.File.exists p |> Result.get_ok then Some p
15
15
else None
+2
-2
day11/doc/tool_binaries.mli
+2
-2
day11/doc/tool_binaries.mli
···
4
4
layers), we just bind-mount the specific binaries we need. *)
5
5
6
6
val find_binary :
7
-
Day11_layer.Layer_type.tool -> string -> Fpath.t option
7
+
Day11_opam_layer.Tool.t -> string -> Fpath.t option
8
8
(** [find_binary tool name] finds a binary called [name] in the
9
9
tool layer's installed binaries. Returns [None] if not found. *)
10
10
11
11
val doc_tool_mounts :
12
-
Day11_layer.Layer_type.tool ->
12
+
Day11_opam_layer.Tool.t ->
13
13
(Day11_container.Mount.t list * string * string)
14
14
(** [doc_tool_mounts tool] returns [(mounts, odoc_bin, odoc_md_bin)]
15
15
where [mounts] are bind mounts for the tool binaries and
+65
day11/doc_layer/README.md
+65
day11/doc_layer/README.md
···
1
+
# doc_layer — odoc doc-layer sidecars
2
+
3
+
A small data-only library that defines the on-disk format for odoc
4
+
documentation layers in the day11 cache.
5
+
6
+
The only thing in here is `Doc_meta`, which serializes the
7
+
[`doc.json`](#doc-meta) sidecar that lives next to a layer's
8
+
`layer.json`. The presence of `doc.json` marks a layer as odoc
9
+
output.
10
+
11
+
This library is intentionally tiny: one module, no opam dependency,
12
+
no recursive types. It depends only on
13
+
[`day11_layer`](../layer/) and `yojson`. Anything that wants to
14
+
enumerate or interpret doc layers can link this library without
15
+
pulling in the full opam-format / opam package universe.
16
+
17
+
## Module
18
+
19
+
### `Doc_meta`
20
+
21
+
```ocaml
22
+
type phase = Compile | Link | Doc_all
23
+
24
+
val string_of_phase : phase -> string
25
+
val phase_of_string : string -> phase
26
+
27
+
type t = {
28
+
package : string;
29
+
phase : phase;
30
+
deps : string list;
31
+
}
32
+
33
+
val filename : string (* "doc.json" *)
34
+
val save : Fpath.t -> t -> (unit, _) result
35
+
val load : Fpath.t -> (t, _) result
36
+
val exists : Fpath.t -> bool
37
+
```
38
+
39
+
The phase distinguishes the three odoc-driver invocation modes:
40
+
41
+
- **`Compile`** produces `.odoc` files only. Used when packages need
42
+
a separate link phase later.
43
+
- **`Link`** produces `.odocl` linked output, consuming the `.odoc`
44
+
files from a previous compile phase.
45
+
- **`Doc_all`** runs the whole pipeline (compile + link + html) in
46
+
one container. The common case for packages whose dep tree fits
47
+
in one shot.
48
+
49
+
`package` is a string (typically `name.version`) — the library does
50
+
not require it to be a typed `OpamPackage.t`, so doc_layer stays
51
+
opam-independent.
52
+
53
+
## Where doc layers come from
54
+
55
+
The day11 doc pipeline (`day11/doc/generate.ml`) builds a doc layer
56
+
for each documented package version, then writes a `Doc_meta.t` to
57
+
`doc.json` in the layer directory. After that, anyone who wants to
58
+
find or interpret doc layers (e.g. a doc-browsing UI) can scan the
59
+
cache for `doc.json` files and load them via `Doc_meta.load`.
60
+
61
+
## Testing
62
+
63
+
Unit tests in `test/test_doc_layer.ml` cover round-trip save/load,
64
+
all three phase variants, and missing-file handling. No filesystem
65
+
permissions or container runtime required.
+57
day11/doc_layer/doc_meta.ml
+57
day11/doc_layer/doc_meta.ml
···
1
+
type phase = Compile | Link | Doc_all
2
+
3
+
let string_of_phase = function
4
+
| Compile -> "compile"
5
+
| Link -> "link"
6
+
| Doc_all -> "doc-all"
7
+
8
+
let phase_of_string = function
9
+
| "compile" -> Compile
10
+
| "link" -> Link
11
+
| "doc-all" -> Doc_all
12
+
| _ -> Doc_all
13
+
14
+
(* Internal wire record so we can use ppx_deriving_yojson while
15
+
keeping [phase] as a typed variant in the public type. *)
16
+
type wire = {
17
+
package : string;
18
+
phase : string;
19
+
deps : string list; [@default []]
20
+
} [@@deriving yojson { strict = false }]
21
+
22
+
type t = {
23
+
package : string;
24
+
phase : phase;
25
+
deps : string list;
26
+
}
27
+
28
+
let to_wire (t : t) : wire =
29
+
{ package = t.package; phase = string_of_phase t.phase; deps = t.deps }
30
+
31
+
let of_wire (w : wire) : t =
32
+
{ package = w.package; phase = phase_of_string w.phase; deps = w.deps }
33
+
34
+
let filename = "doc.json"
35
+
36
+
let save layer_dir t =
37
+
let path = Fpath.(layer_dir / "doc.json") in
38
+
try
39
+
Yojson.Safe.to_file (Fpath.to_string path) (wire_to_yojson (to_wire t));
40
+
Ok ()
41
+
with exn ->
42
+
Rresult.R.error_msgf "Doc_meta.save %a: %s"
43
+
Fpath.pp path (Printexc.to_string exn)
44
+
45
+
let load layer_dir =
46
+
let path = Fpath.(layer_dir / "doc.json") in
47
+
try
48
+
match wire_of_yojson (Yojson.Safe.from_file (Fpath.to_string path)) with
49
+
| Ok w -> Ok (of_wire w)
50
+
| Error msg ->
51
+
Rresult.R.error_msgf "Doc_meta.load %a: %s" Fpath.pp path msg
52
+
with exn ->
53
+
Rresult.R.error_msgf "Doc_meta.load %a: %s"
54
+
Fpath.pp path (Printexc.to_string exn)
55
+
56
+
let exists layer_dir =
57
+
Bos.OS.File.exists Fpath.(layer_dir / "doc.json") |> Result.value ~default:false
+34
day11/doc_layer/doc_meta.mli
+34
day11/doc_layer/doc_meta.mli
···
1
+
(** odoc doc-pipeline sidecar: per-layer metadata for documentation
2
+
layers (compile / link / doc-all phases of the odoc driver).
3
+
4
+
Written next to {!Day11_layer.Meta} as [doc.json] in the layer
5
+
directory. The presence of this file marks a layer as odoc
6
+
output, as opposed to (e.g.) an opam package build layer marked
7
+
by [build.json] from [day11_opam_layer]. This library is the
8
+
minimal "doc layer" data layer — it depends only on
9
+
[day11_layer], not on any opam-format types.
10
+
11
+
The phase distinguishes the three odoc-driver invocation modes:
12
+
- {!Compile} produces [.odoc] files (compile-only)
13
+
- {!Link} produces [.odocl] linked output
14
+
- {!Doc_all} runs the whole pipeline (compile + link + html)
15
+
in one container, the common case for packages that don't
16
+
need a separate link phase. *)
17
+
18
+
type phase = Compile | Link | Doc_all
19
+
20
+
val string_of_phase : phase -> string
21
+
val phase_of_string : string -> phase
22
+
23
+
type t = {
24
+
package : string;
25
+
phase : phase;
26
+
deps : string list;
27
+
}
28
+
29
+
val filename : string
30
+
(** ["doc.json"] *)
31
+
32
+
val save : Fpath.t -> t -> (unit, [> Rresult.R.msg ]) result
33
+
val load : Fpath.t -> (t, [> Rresult.R.msg ]) result
34
+
val exists : Fpath.t -> bool
+4
day11/doc_layer/dune
+4
day11/doc_layer/dune
+4
day11/doc_layer/test/dune
+4
day11/doc_layer/test/dune
+43
day11/doc_layer/test/test_doc_layer.ml
+43
day11/doc_layer/test/test_doc_layer.ml
···
1
+
(* Tests for the day11_doc_layer library. *)
2
+
3
+
open Day11_doc_layer
4
+
open Day11_test_util.Test_util
5
+
6
+
let is_ok msg r = ok_or_fail msg r |> ignore
7
+
8
+
let test_doc_meta_roundtrip () = with_tmp_dir @@ fun layer_dir ->
9
+
let m : Doc_meta.t = {
10
+
package = "fmt.0.9.0";
11
+
phase = Doc_meta.Doc_all;
12
+
deps = [ "ocaml.5.4.1"; "fmt.0.9.0" ];
13
+
} in
14
+
Doc_meta.save layer_dir m |> is_ok "save";
15
+
Alcotest.(check bool) "exists" true (Doc_meta.exists layer_dir);
16
+
let loaded = Doc_meta.load layer_dir |> ok_or_fail "load" in
17
+
Alcotest.(check string) "package" "fmt.0.9.0" loaded.package;
18
+
Alcotest.(check bool) "phase doc-all" true (loaded.phase = Doc_meta.Doc_all)
19
+
20
+
let test_doc_meta_phases () = with_tmp_dir @@ fun layer_dir ->
21
+
List.iter (fun phase ->
22
+
let m : Doc_meta.t = { package = "x.1"; phase; deps = [] } in
23
+
Doc_meta.save layer_dir m |> is_ok "save";
24
+
let loaded = Doc_meta.load layer_dir |> ok_or_fail "load" in
25
+
Alcotest.(check bool) "phase round-trip" true (loaded.phase = phase)
26
+
) [ Doc_meta.Compile; Doc_meta.Link; Doc_meta.Doc_all ]
27
+
28
+
let test_doc_meta_missing () = with_tmp_dir @@ fun layer_dir ->
29
+
Alcotest.(check bool) "exists false" false (Doc_meta.exists layer_dir);
30
+
match Doc_meta.load layer_dir with
31
+
| Ok _ -> Alcotest.fail "should not load missing"
32
+
| Error _ -> ()
33
+
34
+
let () =
35
+
Alcotest.run "day11_doc_layer"
36
+
[
37
+
( "Doc_meta",
38
+
[
39
+
Alcotest.test_case "roundtrip" `Quick test_doc_meta_roundtrip;
40
+
Alcotest.test_case "all phases" `Quick test_doc_meta_phases;
41
+
Alcotest.test_case "missing" `Quick test_doc_meta_missing;
42
+
] );
43
+
]
+2
-2
day11/jtw/build_tools.mli
+2
-2
day11/jtw/build_tools.mli
···
14
14
extra_repo_dirs:string list ->
15
15
repo_dir:string ->
16
16
solutions:(OpamPackage.t * Day11_graph.Graph.solution) list ->
17
-
(OpamPackage.t * Day11_layer.Layer_type.tool) list
17
+
(OpamPackage.t * Day11_opam_layer.Tool.t) list
18
18
(** Build JTW tools for each compiler version. Returns the built tools. *)
19
19
20
20
val build_and_run :
···
28
28
extra_repo_dirs:string list ->
29
29
repo_dir:string ->
30
30
output:string ->
31
-
nodes:Day11_layer.Layer_type.build list ->
31
+
nodes:Day11_opam_layer.Build.t list ->
32
32
solutions:(OpamPackage.t * Day11_graph.Graph.solution) list ->
33
33
unit
34
34
(** Build tools, generate per-package artifacts and worker.js, then
+9
-7
day11/jtw/generate.ml
+9
-7
day11/jtw/generate.ml
···
1
-
open Day11_layer.Layer_type
1
+
module Build = Day11_opam_layer.Build
2
+
module Tool = Day11_opam_layer.Tool
3
+
type build = Build.t
2
4
3
-
let generate_package env benv ~os_dir ~jtw_tool (node : build) =
4
-
let pkg_dir = build_dir ~os_dir node in
5
-
let installed_libs = Day11_layer.Installed_files.scan_libs
5
+
let generate_package env benv ~os_dir ~(jtw_tool : Tool.t) (node : build) =
6
+
let pkg_dir = Build.dir ~os_dir node in
7
+
let installed_libs = Day11_opam_layer.Installed_files.scan_libs
6
8
~layer_dir:pkg_dir in
7
9
if installed_libs = [] then None
8
10
else
···
32
34
33
35
(** Build worker.js for a solution. Stacks all build layers from the
34
36
solution and runs [jtw opam -o ... stdlib]. *)
35
-
let build_worker env benv ~jtw_tool ~solution_nodes =
37
+
let build_worker env benv ~(jtw_tool : Tool.t) ~solution_nodes =
36
38
let cmd =
37
39
"eval $(opam env) && " ^
38
40
"jtw opam -o /home/opam/jtw-worker-output stdlib" in
···
122
124
List.iter (fun (compiler_v, worker_bl) ->
123
125
let ocaml_ver = OpamPackage.Version.to_string
124
126
(OpamPackage.version compiler_v) in
125
-
let worker_dir = Fpath.(build_dir ~os_dir worker_bl / "fs"
127
+
let worker_dir = Fpath.(Build.dir ~os_dir worker_bl / "fs"
126
128
/ "home" / "opam" / "jtw-worker-output") in
127
129
let worker_dir_s = Fpath.to_string worker_dir in
128
130
if Sys.file_exists worker_dir_s then begin
···
147
149
Hashtbl.iter (fun pkg bl ->
148
150
let pkg_name = OpamPackage.name_to_string pkg in
149
151
let pkg_version = OpamPackage.version_to_string pkg in
150
-
let jtw_output = Fpath.(build_dir ~os_dir bl / "fs"
152
+
let jtw_output = Fpath.(Build.dir ~os_dir bl / "fs"
151
153
/ "home" / "opam" / "jtw-output" / pkg_name / "lib") in
152
154
let jtw_output_s = Fpath.to_string jtw_output in
153
155
if Sys.file_exists jtw_output_s then begin
+6
-6
day11/jtw/generate.mli
+6
-6
day11/jtw/generate.mli
···
15
15
Eio_unix.Stdenv.base ->
16
16
Day11_build.Types.build_env ->
17
17
os_dir:Fpath.t ->
18
-
jtw_tools:(OpamPackage.t * Day11_layer.Layer_type.tool) list ->
19
-
nodes:Day11_layer.Layer_type.build list ->
18
+
jtw_tools:(OpamPackage.t * Day11_opam_layer.Tool.t) list ->
19
+
nodes:Day11_opam_layer.Build.t list ->
20
20
solutions:(OpamPackage.t * Day11_graph.Graph.solution) list ->
21
-
(OpamPackage.t, Day11_layer.Layer_type.build) Hashtbl.t
22
-
* (OpamPackage.t * Day11_layer.Layer_type.build) list
21
+
(OpamPackage.t, Day11_opam_layer.Build.t) Hashtbl.t
22
+
* (OpamPackage.t * Day11_opam_layer.Build.t) list
23
23
(** [run env benv ~os_dir ~jtw_tools ~nodes ~solutions] generates
24
24
per-package JTW artifacts and per-solution worker.js. Returns
25
25
[(jtw_results, worker_layers)] where [jtw_results] maps packages
···
29
29
val assemble :
30
30
os_dir:Fpath.t ->
31
31
output:string ->
32
-
jtw_results:(OpamPackage.t, Day11_layer.Layer_type.build) Hashtbl.t ->
33
-
worker_layers:(OpamPackage.t * Day11_layer.Layer_type.build) list ->
32
+
jtw_results:(OpamPackage.t, Day11_opam_layer.Build.t) Hashtbl.t ->
33
+
worker_layers:(OpamPackage.t * Day11_opam_layer.Build.t) list ->
34
34
solutions:(OpamPackage.t * Day11_graph.Graph.solution) list ->
35
35
unit
36
36
(** [assemble ~os_dir ~output ~jtw_results ~worker_layers ~solutions]
+4
-4
day11/jtw/test/test_jtw_integration.ml
+4
-4
day11/jtw/test/test_jtw_integration.ml
···
44
44
Printf.printf " %d layers\n%!" (List.length tool.builds);
45
45
Alcotest.(check bool) "has layers" true
46
46
(List.length tool.builds > 0);
47
-
let has_jsoo_bin = List.exists (fun (bl : Day11_layer.Layer_type.build) ->
48
-
let bl_dir = Day11_layer.Layer_type.build_dir ~os_dir bl in
47
+
let has_jsoo_bin = List.exists (fun (bl : Day11_opam_layer.Build.t) ->
48
+
let bl_dir = Day11_opam_layer.Build.dir ~os_dir bl in
49
49
let bin = Fpath.(bl_dir / "fs" / "home" / "opam" / ".opam"
50
50
/ Types.switch / "bin" / "js_of_ocaml") in
51
51
Bos.OS.File.exists bin |> Result.get_ok
···
104
104
let jtw_pkg = OpamPackage.of_string "jtw-tools.0" in
105
105
let layer_hash = Day11_layer.Hash.of_strings
106
106
[ "jtw-tools"; base.hash; jtw_local_source ] in
107
-
let jtw_node : Day11_layer.Layer_type.build =
107
+
let jtw_node : Day11_opam_layer.Build.t =
108
108
{ hash = layer_hash; pkg = jtw_pkg; deps = tool.builds; universe = Day11_graph.Universe.dummy } in
109
109
let result =
110
110
Build_layer.build env benv
···
115
115
match result with
116
116
| Types.Success bl ->
117
117
Printf.printf " JTW tools layer: %s\n%!" bl.hash;
118
-
let bl_dir = Day11_layer.Layer_type.build_dir ~os_dir bl in
118
+
let bl_dir = Day11_opam_layer.Build.dir ~os_dir bl in
119
119
(* Check for jtw binary *)
120
120
let has_jtw = Bos.OS.File.exists
121
121
Fpath.(bl_dir / "fs" / "home" / "opam" / ".opam"
+94
-123
day11/layer/README.md
+94
-123
day11/layer/README.md
···
1
-
# layer — On-disk layer management
1
+
# layer — Generic on-disk layer cache primitives
2
2
3
-
Data-layer abstraction for the day11 build cache. Knows about the
4
-
on-disk directory structure, JSON metadata format, and file discovery
5
-
within layer trees, but nothing about *how* layers are built — that's
6
-
the container and build libraries' concern.
3
+
A domain-agnostic abstraction for content-addressed build layers stored
4
+
on disk. Knows about layer directories, generic JSON metadata, file
5
+
scanning, hardlink merging, and overlay-mount planning. Knows nothing
6
+
about opam, packages, doc generation, or any specific build pipeline.
7
+
8
+
For opam-flavoured layers see the sister library
9
+
[`day11_opam_layer`](../opam_layer/), which adds the
10
+
package-specific sidecars and helpers.
7
11
8
12
## External dependencies
9
13
10
14
- `day11_exec` — sudo wrappers, subprocess execution
11
-
- `day11_graph` — `Universe.t` type
12
-
- `yojson` + `ppx_deriving_yojson` — `layer.json` serialization
13
-
- `opam-format` — `OpamPackage` type
14
15
- `bos`, `fpath`, `rresult` — filesystem helpers
16
+
- `yojson` + `ppx_deriving_yojson` — `layer.json` serialization
15
17
16
-
Does NOT depend on the solver, build pipeline, or container orchestration.
18
+
Does NOT depend on `opam-format`, the solver, the doc pipeline, or
19
+
the container orchestration.
17
20
18
21
## On-disk layout
19
22
···
21
24
22
25
```
23
26
build-{hash[:12]}/
24
-
layer.json — typed metadata (see Layer_meta.build_meta)
25
-
layer.log — captured stdout/stderr from the container
27
+
layer.json — generic metadata (see Layer_meta.t)
28
+
layer.log — captured stdout/stderr from the build
26
29
last_used — sentinel file; mtime is the LRU timestamp
27
30
fs/ — overlay upper: new/changed files from the build
28
31
29
-
packages/{pkg.version}/
30
-
build-{hash} — symlink to ../../build-{hash[:12]}
31
-
blessed-build — symlink to the chosen canonical build layer
32
+
build.json — opam-package-build sidecar (Day11_opam_layer.Build_meta)
33
+
doc.json — odoc layer sidecar (Day11_opam_layer.Doc_meta)
34
+
... — future domains can add their own sidecars
35
+
36
+
packages/{id}/
37
+
build-{hash} — symlink registry, see Layer_symlinks
32
38
```
33
39
34
-
A layer's directory name uses the first 12 hex chars of its content
35
-
hash. Cache hits are determined by recomputing the hash from inputs
36
-
(base image, deps, package) and checking whether `{os_dir}/build-{hash[:12]}/layer.json` exists.
40
+
The "kind" of a layer is determined by which sidecar files exist in
41
+
its directory, not by a field inside `layer.json`. The generic library
42
+
never enumerates the set of possible kinds; each domain library owns
43
+
its own sidecar format and the convention for which filename it uses.
44
+
45
+
**Sidecar files must be valid JSON** (typically a single object at
46
+
the top level). This convention is unenforced by the library — no
47
+
part of `day11_layer` reads sidecars — but tools like
48
+
`day11-layer-cli` rely on it so they can pretty-print sidecar
49
+
contents without depending on any domain-specific library.
37
50
38
51
## Modules
39
52
40
-
### `Layer_type` — in-memory DAG types
53
+
### `Layer_type`
41
54
42
55
```ocaml
43
-
type build = {
44
-
hash : string;
45
-
pkg : OpamPackage.t;
46
-
deps : build list;
47
-
universe : Day11_graph.Universe.t;
48
-
}
49
56
type base = { hash : string; dir : Fpath.t; image : string }
50
-
type tool = { hash : string; dir : Fpath.t; builds : build list }
51
-
52
-
val build_dir_name : build -> string
53
-
val build_dir : os_dir:Fpath.t -> build -> Fpath.t
54
57
```
55
58
56
-
Recursive: a `build` carries its dep tree inline. Used by both the
57
-
planner (before building) and the executor (after).
59
+
The base image layer at the bottom of every overlay stack. Recursive
60
+
build-DAG types live in domain libraries (e.g.
61
+
`Day11_opam_layer.Build`).
62
+
63
+
### `Hash`
58
64
59
-
### `Hash` — content-addressed identity
65
+
Content-addressed hashing primitives.
60
66
61
67
```ocaml
62
68
val of_strings : string list -> string
63
69
val base_hash : image:string -> string
64
-
val layer_hash : base_hash:string -> dep_hashes:string list -> pkg:string -> string
70
+
val layer_hash :
71
+
base_hash:string -> dep_hashes:string list -> pkg:string -> string
65
72
```
66
73
67
-
### `Layer_meta` — `layer.json` read/write
74
+
### `Layer_dir`
68
75
69
76
```ocaml
70
-
type kind = Build | Compile | Link | Doc_all
77
+
val name : string -> string
78
+
val path : os_dir:Fpath.t -> string -> Fpath.t
79
+
```
80
+
81
+
The `build-XXXXXXXXXXXX` directory naming convention. The `build-`
82
+
prefix is historical; this module uses it uniformly across all layer
83
+
kinds.
84
+
85
+
### `Layer_meta`
86
+
87
+
The generic per-layer JSON record stored as `layer.json`.
88
+
89
+
```ocaml
71
90
type timing = (string * float) list
72
-
type build_meta = { package; kind; exit_status; deps; hashes;
73
-
uid; gid; base_hash; installed_libs; installed_docs;
74
-
patches; failed_dep; disk_usage; timing; created_at }
91
+
92
+
type t = {
93
+
exit_status : int;
94
+
parent_hashes : string list;
95
+
uid : int;
96
+
gid : int;
97
+
base_hash : string;
98
+
disk_usage : int;
99
+
timing : timing;
100
+
created_at : string;
101
+
failed_dep : string option;
102
+
}
75
103
76
-
val save_build : ?created_at:string -> Fpath.t -> build_meta -> (unit, _) result
77
-
val load_build : Fpath.t -> (build_meta, _) result
78
-
val load_build_tree : os_dir:Fpath.t -> string -> (Layer_type.build, _) result
104
+
val save : ?created_at:string -> Fpath.t -> t -> (unit, _) result
105
+
val load : Fpath.t -> (t, _) result
79
106
```
80
107
81
-
Round-trips through an internal wire record so the public type can
82
-
carry typed variants (`kind`) while the on-disk JSON stays open and
83
-
additive-schema-friendly. Unknown phase names in `timing` and unknown
84
-
values for `kind` are tolerated on read.
108
+
Domain-specific information lives in sidecar JSON files in the same
109
+
directory, owned by the relevant domain library.
85
110
86
-
### `Last_used` — LRU sentinel
111
+
### `Last_used`
87
112
88
113
```ocaml
89
114
val touch : Fpath.t -> unit
90
115
val get : Fpath.t -> float option
91
116
```
92
117
93
-
Records the last-access time by touching a sentinel file. Cheap enough
94
-
to call from every dep-lookup path. Split off from `Layer_meta` so a
95
-
touch doesn't rewrite the JSON.
118
+
Per-layer LRU sentinel. Cheap enough to call from every dep-lookup
119
+
path. Split off from `Layer_meta` so a touch doesn't rewrite JSON.
96
120
97
-
### `Installed_files` — content scanning
121
+
### `Stack`
98
122
99
-
```ocaml
100
-
val scan_libs : layer_dir:Fpath.t -> string list
101
-
val scan_docs : layer_dir:Fpath.t -> string list
102
-
```
103
-
104
-
Walks the `fs/` overlay for `.cmi`/`.cmxa`/`META`/etc. (libs) or
105
-
`.mld`/`odoc-config.sexp` (docs). Called after a build to populate
106
-
`build_meta.installed_libs` and `installed_docs`.
107
-
108
-
### `Stack` — combining dep layers
123
+
Layer combining for overlayfs assembly.
109
124
110
125
```ocaml
111
126
val merge : env -> layer_dirs:Fpath.t list -> target:Fpath.t -> (unit, _) result
···
117
132
Fpath.t list * Fpath.t list
118
133
```
119
134
120
-
`merge` cp-hardlinks the `fs/` subtree of every layer into a single
121
-
target directory. Near-zero disk cost because it uses `cp --link`.
122
-
123
-
`plan_lowerdir` splits a list of dep layers into "keep separate" and
124
-
"cp-merge" buckets so the resulting overlayfs mount options string
125
-
stays under the kernel's PAGE_SIZE limit. Pure computation — no
126
-
filesystem access. The caller supplies pre-computed byte costs so the
127
-
function doesn't have to know about option syntax.
135
+
`merge` cp-hardlinks the `fs/` of every layer into a single target
136
+
directory. `plan_lowerdir` decides which layers to keep as separate
137
+
overlayfs lowerdirs and which to merge, given a byte budget for the
138
+
mount-options string.
128
139
129
-
### `Package_symlinks` — per-package tracking
140
+
### `Layer_symlinks`
130
141
131
142
```ocaml
132
-
val ensure_layer_symlink :
133
-
packages_dir:Fpath.t -> pkg_str:string -> layer_name:string ->
143
+
val ensure :
144
+
packages_dir:Fpath.t -> id:string -> layer_name:string ->
134
145
(unit, _) result
135
146
```
136
147
137
-
Each successful build adds a symlink under `packages/{pkg.version}/`
138
-
pointing to its hash-addressed layer directory. Lets you enumerate
139
-
every layer that's ever been built for a package.
140
-
141
-
### `Scan` — directory enumeration
142
-
143
-
```ocaml
144
-
val list_layers : Fpath.t -> (string * Fpath.t) list
145
-
val list_package_symlinks :
146
-
?exclude:string list -> Fpath.t -> string -> (string * string) list
147
-
```
148
-
149
-
Low-level directory listing. Caller filters and interprets names.
150
-
151
-
### `Import` — bootstrapping from Docker
152
-
153
-
```ocaml
154
-
val from_docker :
155
-
env -> image:string -> layer_dir:Fpath.t -> (unit, _) result
156
-
```
148
+
A small per-id registry. The `id` is opaque to this library — opam
149
+
callers pass `name.version` strings, but anything goes.
157
150
158
-
Creates a base layer by exporting a Docker image's filesystem.
151
+
### `Scan`
159
152
160
-
### `Opam_repo` — assembling an opam repo subtree
161
-
162
-
```ocaml
163
-
val create : Fpath.t -> (Fpath.t, _) result
164
-
val populate :
165
-
opam_repo:Fpath.t -> opam_repositories:Fpath.t list ->
166
-
OpamPackage.t list -> (unit, _) result
167
-
```
168
-
169
-
Builds a minimal `opam-repository/` tree containing just the opam
170
-
files needed for a package and its deps. Used when building with a
171
-
pinned set of repo state.
172
-
173
-
### `Opamh` — opam switch state helpers
153
+
Directory enumeration: list layer dirs and per-id symlinks. Generic;
154
+
caller filters and interprets.
174
155
175
-
```ocaml
176
-
val compiler_packages : OpamPackage.Name.t list
177
-
val dump_state : Fpath.t list -> Fpath.t -> (unit, _) result
178
-
```
156
+
### `Import`
179
157
180
-
Identifies compiler packages (`ocaml`, `ocaml-base-compiler`, etc.)
181
-
and writes a `switch-state` file describing what's installed, for
182
-
use inside containers.
158
+
Bootstrap a base layer by exporting a Docker image.
183
159
184
160
## Error-handling convention
185
161
186
162
| Operation kind | Returns |
187
163
|---|---|
188
-
| Read, maybe-exists lookup | `_ option` (`None` on missing) |
164
+
| Read, maybe-exists lookup | `_ option` |
189
165
| Read, must-exist or parse | `(_, [> Rresult.R.msg]) result` |
190
166
| Write / create / mutate | `(_, [> Rresult.R.msg]) result` |
191
-
| Best-effort bookkeeping (e.g. LRU touch) | `unit`, silent on error |
192
-
193
-
The `Last_used.touch` exception is deliberate — LRU bookkeeping must
194
-
never fail a build, so it catches everything and does nothing on
195
-
error. Any other function that can observably fail returns a
196
-
`Result`.
167
+
| Best-effort bookkeeping (LRU touch) | `unit`, silent |
197
168
198
169
## Testing
199
170
200
-
Unit tests in `test/` cover every module without requiring root or
201
-
container runtime. Integration tests that actually mount overlayfs
202
-
live in `day11/container/test/test_integration.ml` and are gated on
203
-
`DAY11_INTEGRATION=true`.
171
+
Unit tests in `test/` cover every module without requiring root or a
172
+
container runtime. They run on any platform where OCaml builds.
173
+
Integration tests that actually mount overlayfs live in
174
+
`day11/container/test/` and are gated on `DAY11_INTEGRATION=true`.
+5
day11/layer/base.ml
+5
day11/layer/base.ml
+13
day11/layer/base.mli
+13
day11/layer/base.mli
···
1
+
(** The base image layer.
2
+
3
+
A {!t} represents the foundational layer at the bottom of every
4
+
overlay stack — typically a Debian rootfs imported from a Docker
5
+
image, with opam preinstalled. Higher-level layer types (opam
6
+
package builds, odoc doc layers) live in domain-specific
7
+
libraries, e.g. [day11_opam_layer]. *)
8
+
9
+
type t = {
10
+
hash : string;
11
+
dir : Fpath.t;
12
+
image : string;
13
+
}
+195
-209
day11/layer/cli/layer_cli.ml
+195
-209
day11/layer/cli/layer_cli.ml
···
1
1
(** Low-level layer cache inspection tool.
2
2
3
-
Uses only the day11_layer library — no solver, no build, no doc
4
-
pipeline. Reads layer.json files and the on-disk cache structure
5
-
directly. *)
3
+
Uses only the day11_layer library — no opam, no solver, no build
4
+
pipeline. Reads layer.json files and lists directory contents
5
+
directly, without interpreting any domain-specific sidecar
6
+
(build.json, doc.json, etc.).
7
+
8
+
For domain-aware inspection (package names, phase classification)
9
+
use a higher-level tool that depends on the appropriate domain
10
+
library. *)
6
11
7
12
open Cmdliner
8
13
module L = Day11_layer
9
14
10
-
(* ── Helpers ─────────────────────────────────────────────────────────── *)
15
+
(* ── Helpers ─────────────────────────────────────────────────────── *)
11
16
12
17
let fpath = Fpath.v
13
18
14
-
(** Status string derived from build_meta. *)
15
-
let status_of (m : L.Layer_meta.build_meta) =
19
+
(** Status string derived from layer meta. *)
20
+
let status_of (m : L.Meta.t) =
16
21
if m.exit_status = 0 then "ok"
17
22
else if m.failed_dep <> None then "cascade"
18
23
else "fail"
19
-
20
-
(** Kind string for display. *)
21
-
let kind_of (m : L.Layer_meta.build_meta) = L.Layer_meta.string_of_kind m.kind
22
24
23
25
(** Short hash for display. *)
24
26
let short h = if String.length h >= 12 then String.sub h 0 12 else h
25
27
26
28
let load_meta layer_dir =
27
-
L.Layer_meta.load_build Fpath.(layer_dir / "layer.json")
29
+
L.Meta.load Fpath.(layer_dir / "layer.json")
30
+
31
+
(** List every non-layer-core file in the layer directory. Used to
32
+
show what sidecars etc. are present. *)
33
+
let list_extras layer_dir =
34
+
let core = [ "layer.json"; "layer.log"; "last_used"; "fs" ] in
35
+
try
36
+
Sys.readdir (Fpath.to_string layer_dir)
37
+
|> Array.to_list
38
+
|> List.filter (fun f -> not (List.mem f core))
39
+
|> List.sort compare
40
+
with Sys_error _ -> []
28
41
29
-
(** Walk all layer directories under [os_dir] and apply [f] to each
30
-
[(name, layer_dir, meta)]. Layers without a readable layer.json
31
-
are skipped silently. *)
42
+
(** Walk all layer directories under [os_dir] and apply [f]. *)
32
43
let fold_layers os_dir init f =
33
44
L.Scan.list_layers os_dir
34
45
|> List.fold_left (fun acc (name, layer_dir) ->
···
36
47
| Ok meta -> f acc name layer_dir meta
37
48
| Error _ -> acc) init
38
49
39
-
(* ── list ────────────────────────────────────────────────────────────── *)
50
+
(** Check whether a named file exists in a layer dir. *)
51
+
let has_file layer_dir name =
52
+
Bos.OS.File.exists Fpath.(layer_dir / name)
53
+
|> Result.value ~default:false
40
54
41
-
let cmd_list os_dir kind status pkg_filter limit sort_lru =
55
+
(* ── list ────────────────────────────────────────────────────────── *)
56
+
57
+
let cmd_list os_dir status has limit sort_lru =
42
58
let os_dir = fpath os_dir in
43
-
let matches name (m : L.Layer_meta.build_meta) =
44
-
(match kind with
45
-
| None -> true
46
-
| Some k -> L.Layer_meta.string_of_kind m.kind = k) &&
59
+
let matches _name layer_dir (m : L.Meta.t) =
47
60
(match status with None -> true | Some s -> status_of m = s) &&
48
-
(match pkg_filter with
49
-
| None -> true
50
-
| Some p ->
51
-
let s = m.package in
52
-
let _ = name in
53
-
(* substring or exact name match *)
54
-
try ignore (Str.search_forward (Str.regexp_string p) s 0); true
55
-
with Not_found -> false)
61
+
(match has with
62
+
| [] -> true
63
+
| files -> List.for_all (has_file layer_dir) files)
56
64
in
57
65
let entries = fold_layers os_dir [] (fun acc name layer_dir m ->
58
-
if matches name m
66
+
if matches name layer_dir m
59
67
then (name, layer_dir, m, L.Last_used.get layer_dir) :: acc
60
68
else acc)
61
69
in
62
70
let entries =
63
71
if sort_lru then
64
-
(* Oldest "last used" first; never-used layers sort first as 0.0 *)
65
72
List.sort (fun (_, _, _, a) (_, _, _, b) ->
66
73
let av = match a with Some t -> t | None -> 0.0 in
67
74
let bv = match b with Some t -> t | None -> 0.0 in
68
75
compare av bv) entries
69
76
else
70
77
List.sort (fun (_, _, a, _) (_, _, b, _) ->
71
-
String.compare a.L.Layer_meta.created_at b.L.Layer_meta.created_at)
78
+
String.compare a.L.Meta.created_at b.L.Meta.created_at)
72
79
entries
73
80
in
74
81
let n_total = List.length entries in
···
91
98
tm.tm_hour tm.tm_min tm.tm_sec
92
99
in
93
100
let date_col_label = if sort_lru then "LAST USED" else "CREATED" in
94
-
Printf.printf "%-14s %-9s %-8s %-19s %s\n"
95
-
"HASH" "KIND" "STATUS" date_col_label "PACKAGE";
96
-
Printf.printf "%-14s %-9s %-8s %-19s %s\n"
97
-
(String.make 12 '-') (String.make 9 '-')
98
-
(String.make 8 '-') (String.make 19 '-') (String.make 30 '-');
99
-
List.iter (fun (name, _dir, (m : L.Layer_meta.build_meta), lru) ->
101
+
Printf.printf "%-14s %-8s %-19s %-8s %s\n"
102
+
"HASH" "STATUS" date_col_label "DISK" "EXTRA FILES";
103
+
Printf.printf "%-14s %-8s %-19s %-8s %s\n"
104
+
(String.make 12 '-') (String.make 8 '-')
105
+
(String.make 19 '-') (String.make 8 '-') (String.make 30 '-');
106
+
List.iter (fun (name, layer_dir, (m : L.Meta.t), lru) ->
100
107
let hash = match String.index_opt name '-' with
101
108
| Some i -> String.sub name (i + 1) (String.length name - i - 1)
102
109
| None -> name
···
106
113
else if String.length m.created_at >= 19
107
114
then String.sub m.created_at 0 19 else m.created_at
108
115
in
109
-
Printf.printf "%-14s %-9s %-8s %-19s %s\n"
110
-
(short hash) (kind_of m) (status_of m) date_col m.package
116
+
let extras = list_extras layer_dir in
117
+
let extras_s =
118
+
if extras = [] then "(none)"
119
+
else String.concat " " extras
120
+
in
121
+
let disk_s =
122
+
if m.disk_usage >= 1_000_000 then
123
+
Printf.sprintf "%dM" (m.disk_usage / 1_000_000)
124
+
else if m.disk_usage >= 1_000 then
125
+
Printf.sprintf "%dK" (m.disk_usage / 1_000)
126
+
else Printf.sprintf "%dB" m.disk_usage
127
+
in
128
+
Printf.printf "%-14s %-8s %-19s %-8s %s\n"
129
+
(short hash) (status_of m) date_col disk_s extras_s
111
130
) entries;
112
131
Printf.printf "\n(showing %d of %d layers)\n" (List.length entries) n_total;
113
132
0
114
133
115
-
(* ── show ────────────────────────────────────────────────────────────── *)
134
+
(* ── show ────────────────────────────────────────────────────────── *)
116
135
117
136
let find_layer_by_prefix os_dir prefix =
118
137
L.Scan.list_layers os_dir
···
126
145
then Some (name, layer_dir)
127
146
else None)
128
147
129
-
let cmd_show os_dir hash_prefix =
148
+
let with_resolved_layer os_dir hash_prefix f =
130
149
let os_dir = fpath os_dir in
131
150
match find_layer_by_prefix os_dir hash_prefix with
132
151
| [] ->
···
135
154
Printf.eprintf "Ambiguous prefix %s, matches:\n" hash_prefix;
136
155
List.iter (fun (n, _) -> Printf.eprintf " %s\n" n) matches;
137
156
2
138
-
| [ (name, layer_dir) ] ->
139
-
match load_meta layer_dir with
140
-
| Error (`Msg e) ->
141
-
Printf.eprintf "%s: %s\n" name e; 1
142
-
| Ok m ->
143
-
Printf.printf "Layer: %s\n" name;
144
-
Printf.printf "Path: %s\n" (Fpath.to_string layer_dir);
145
-
Printf.printf "Package: %s\n" m.package;
146
-
Printf.printf "Kind: %s\n" (kind_of m);
147
-
Printf.printf "Status: %s (exit %d)\n" (status_of m) m.exit_status;
148
-
Printf.printf "Created: %s\n" m.created_at;
149
-
(match L.Last_used.get layer_dir with
150
-
| Some t ->
151
-
let tm = Unix.gmtime t in
152
-
Printf.printf "Last used: %04d-%02d-%02dT%02d:%02d:%02dZ\n"
153
-
(tm.tm_year + 1900) (tm.tm_mon + 1) tm.tm_mday
154
-
tm.tm_hour tm.tm_min tm.tm_sec
155
-
| None -> Printf.printf "Last used: (never recorded)\n");
156
-
Printf.printf "Base: %s\n" m.base_hash;
157
-
Printf.printf "UID/GID: %d:%d\n" m.uid m.gid;
158
-
Printf.printf "Disk: %d bytes\n" m.disk_usage;
159
-
(match m.failed_dep with
160
-
| Some d -> Printf.printf "Failed dep: %s\n" d
161
-
| None -> ());
162
-
Printf.printf "\nDeps (%d):\n" (List.length m.deps);
163
-
List.iter2 (fun d h ->
164
-
Printf.printf " %s %s\n" (short h) d
165
-
) m.deps m.hashes;
166
-
if m.patches <> [] then begin
167
-
Printf.printf "\nPatches (%d):\n" (List.length m.patches);
168
-
List.iter (fun p -> Printf.printf " %s\n" p) m.patches
169
-
end;
170
-
if m.timing <> [] then begin
171
-
Printf.printf "\nTiming (s):\n";
172
-
List.iter (fun (name, secs) ->
173
-
Printf.printf " %-16s %.3f\n" (name ^ ":") secs
174
-
) m.timing
175
-
end;
176
-
if m.installed_libs <> [] then
177
-
Printf.printf "\nInstalled libs: %d files\n"
178
-
(List.length m.installed_libs);
179
-
if m.installed_docs <> [] then
180
-
Printf.printf "Installed docs: %d files\n"
181
-
(List.length m.installed_docs);
182
-
0
157
+
| [ (name, layer_dir) ] -> f os_dir name layer_dir
158
+
159
+
let cmd_show os_dir hash_prefix =
160
+
with_resolved_layer os_dir hash_prefix @@ fun _os_dir name layer_dir ->
161
+
match load_meta layer_dir with
162
+
| Error (`Msg e) ->
163
+
Printf.eprintf "%s: %s\n" name e; 1
164
+
| Ok m ->
165
+
Printf.printf "Layer: %s\n" name;
166
+
Printf.printf "Path: %s\n" (Fpath.to_string layer_dir);
167
+
Printf.printf "Status: %s (exit %d)\n" (status_of m) m.exit_status;
168
+
Printf.printf "Created: %s\n" m.created_at;
169
+
(match L.Last_used.get layer_dir with
170
+
| Some t ->
171
+
let tm = Unix.gmtime t in
172
+
Printf.printf "Last used: %04d-%02d-%02dT%02d:%02d:%02dZ\n"
173
+
(tm.tm_year + 1900) (tm.tm_mon + 1) tm.tm_mday
174
+
tm.tm_hour tm.tm_min tm.tm_sec
175
+
| None -> Printf.printf "Last used: (never recorded)\n");
176
+
Printf.printf "Base: %s\n" m.base_hash;
177
+
Printf.printf "UID/GID: %d:%d\n" m.uid m.gid;
178
+
Printf.printf "Disk: %d bytes\n" m.disk_usage;
179
+
(match m.failed_dep with
180
+
| Some d -> Printf.printf "Failed dep: %s\n" d
181
+
| None -> ());
182
+
Printf.printf "\nParent layers (%d):\n" (List.length m.parent_hashes);
183
+
List.iter (fun h -> Printf.printf " %s\n" (short h)) m.parent_hashes;
184
+
let extras = list_extras layer_dir in
185
+
List.iter (fun f ->
186
+
let p = Fpath.(layer_dir / f) in
187
+
Printf.printf "\nSidecar: %s\n" f;
188
+
match Yojson.Safe.from_file (Fpath.to_string p) with
189
+
| json ->
190
+
let pretty = Yojson.Safe.pretty_to_string json in
191
+
(* Indent each line by two spaces for visual nesting. *)
192
+
let lines = String.split_on_char '\n' pretty in
193
+
List.iter (fun line -> Printf.printf " %s\n" line) lines
194
+
| exception exn ->
195
+
let size =
196
+
try (Unix.stat (Fpath.to_string p)).Unix.st_size
197
+
with _ -> -1
198
+
in
199
+
Printf.printf " (not valid JSON: %s, %d bytes)\n"
200
+
(Printexc.to_string exn) size
201
+
) extras;
202
+
if m.timing <> [] then begin
203
+
Printf.printf "\nTiming (s):\n";
204
+
List.iter (fun (tname, secs) ->
205
+
Printf.printf " %-16s %.3f\n" (tname ^ ":") secs
206
+
) m.timing
207
+
end;
208
+
0
183
209
184
-
(* ── tree ────────────────────────────────────────────────────────────── *)
210
+
(* ── tree ────────────────────────────────────────────────────────── *)
185
211
186
212
let cmd_tree os_dir hash_prefix =
187
-
let os_dir = fpath os_dir in
188
-
match find_layer_by_prefix os_dir hash_prefix with
189
-
| [] -> Printf.eprintf "No layer with hash prefix %s\n" hash_prefix; 1
190
-
| _ :: _ :: _ as ms ->
191
-
Printf.eprintf "Ambiguous prefix:\n";
192
-
List.iter (fun (n, _) -> Printf.eprintf " %s\n" n) ms; 2
193
-
| [ (name, _layer_dir) ] ->
194
-
let full_hash = match String.index_opt name '-' with
195
-
| Some i -> String.sub name (i + 1) (String.length name - i - 1)
196
-
| None -> name
197
-
in
198
-
(* load_build_tree expects the FULL hash, but our layer dirs use
199
-
12-char short hashes. Walk the tree by hand using load_meta. *)
200
-
let visited = Hashtbl.create 32 in
201
-
let rec walk depth name =
202
-
let prefix = String.make (depth * 2) ' ' in
203
-
let layer_dir = Fpath.(os_dir / name) in
204
-
if Hashtbl.mem visited name then
205
-
Printf.printf "%s%s (already shown)\n" prefix name
206
-
else begin
207
-
Hashtbl.add visited name ();
208
-
match load_meta layer_dir with
209
-
| Error _ ->
210
-
Printf.printf "%s%s (no layer.json)\n" prefix name
211
-
| Ok m ->
212
-
Printf.printf "%s%s [%s] %s %s\n"
213
-
prefix name (kind_of m) (status_of m) m.package;
214
-
List.iter (fun h ->
215
-
let dep_name = "build-" ^ short h in
216
-
walk (depth + 1) dep_name
217
-
) m.hashes
218
-
end
219
-
in
220
-
walk 0 ("build-" ^ short full_hash);
221
-
0
213
+
with_resolved_layer os_dir hash_prefix @@ fun os_dir name _layer_dir ->
214
+
let full_hash = match String.index_opt name '-' with
215
+
| Some i -> String.sub name (i + 1) (String.length name - i - 1)
216
+
| None -> name
217
+
in
218
+
let visited = Hashtbl.create 32 in
219
+
let rec walk depth dname =
220
+
let prefix = String.make (depth * 2) ' ' in
221
+
let layer_dir = Fpath.(os_dir / dname) in
222
+
if Hashtbl.mem visited dname then
223
+
Printf.printf "%s%s (already shown)\n" prefix dname
224
+
else begin
225
+
Hashtbl.add visited dname ();
226
+
match load_meta layer_dir with
227
+
| Error _ ->
228
+
Printf.printf "%s%s (no layer.json)\n" prefix dname
229
+
| Ok m ->
230
+
let extras = list_extras layer_dir in
231
+
let tag =
232
+
if extras = [] then ""
233
+
else " [" ^ String.concat " " extras ^ "]"
234
+
in
235
+
Printf.printf "%s%s %s%s\n"
236
+
prefix dname (status_of m) tag;
237
+
List.iter (fun h ->
238
+
let dep_name = "build-" ^ short h in
239
+
walk (depth + 1) dep_name
240
+
) m.parent_hashes
241
+
end
242
+
in
243
+
walk 0 ("build-" ^ short full_hash);
244
+
0
222
245
223
-
(* ── stats ───────────────────────────────────────────────────────────── *)
246
+
(* ── stats ───────────────────────────────────────────────────────── *)
224
247
225
248
let cmd_stats os_dir =
226
249
let os_dir = fpath os_dir in
227
-
let by_kind_status = Hashtbl.create 8 in
250
+
let by_status = Hashtbl.create 4 in
251
+
let by_extra_set = Hashtbl.create 8 in
228
252
let total_disk = ref 0 in
229
-
let n = fold_layers os_dir 0 (fun acc _ _ m ->
230
-
let key = (kind_of m, status_of m) in
231
-
let cur = try Hashtbl.find by_kind_status key with Not_found -> 0 in
232
-
Hashtbl.replace by_kind_status key (cur + 1);
253
+
let n = fold_layers os_dir 0 (fun acc _ layer_dir m ->
254
+
let st = status_of m in
255
+
let cur = try Hashtbl.find by_status st with Not_found -> 0 in
256
+
Hashtbl.replace by_status st (cur + 1);
257
+
let key = String.concat " " (list_extras layer_dir) in
258
+
let key = if key = "" then "(none)" else key in
259
+
let cur2 = try Hashtbl.find by_extra_set key with Not_found -> 0 in
260
+
Hashtbl.replace by_extra_set key (cur2 + 1);
233
261
total_disk := !total_disk + m.disk_usage;
234
262
acc + 1)
235
263
in
236
264
Printf.printf "Total layers: %d\n" n;
237
265
Printf.printf "Total disk: %d bytes (%.1f GB)\n"
238
266
!total_disk (float_of_int !total_disk /. 1e9);
239
-
Printf.printf "\nBy kind and status:\n";
240
-
let entries = Hashtbl.fold (fun k v acc -> (k, v) :: acc) by_kind_status [] in
241
-
let entries = List.sort compare entries in
242
-
Printf.printf " %-12s %-9s %s\n" "KIND" "STATUS" "COUNT";
243
-
Printf.printf " %-12s %-9s %s\n" "----" "------" "-----";
244
-
List.iter (fun ((kind, status), count) ->
245
-
Printf.printf " %-12s %-9s %d\n" kind status count
246
-
) entries;
267
+
Printf.printf "\nBy status:\n";
268
+
Hashtbl.iter (fun k v ->
269
+
Printf.printf " %-10s %d\n" k v) by_status;
270
+
Printf.printf "\nBy extra-file set (i.e. which sidecars are present):\n";
271
+
let entries = Hashtbl.fold (fun k v acc -> (k, v) :: acc) by_extra_set [] in
272
+
let entries = List.sort (fun (_, a) (_, b) -> compare b a) entries in
273
+
List.iter (fun (key, count) ->
274
+
Printf.printf " %-40s %d\n" key count) entries;
247
275
0
248
276
249
-
(* ── package ─────────────────────────────────────────────────────────── *)
250
-
251
-
let cmd_package os_dir pkg =
252
-
let os_dir = fpath os_dir in
253
-
let entries = fold_layers os_dir [] (fun acc name dir m ->
254
-
if m.L.Layer_meta.package = pkg then (name, dir, m) :: acc else acc)
255
-
in
256
-
if entries = [] then begin
257
-
Printf.eprintf "No layers for package %s\n" pkg; 1
258
-
end else begin
259
-
let entries = List.sort (fun (_, _, a) (_, _, b) ->
260
-
String.compare a.L.Layer_meta.created_at b.L.Layer_meta.created_at)
261
-
entries
262
-
in
263
-
Printf.printf "Layers for %s (%d):\n\n" pkg (List.length entries);
264
-
Printf.printf "%-14s %-9s %-8s %-19s %s\n"
265
-
"HASH" "KIND" "STATUS" "CREATED" "DEPS";
266
-
List.iter (fun (name, _, (m : L.Layer_meta.build_meta)) ->
267
-
let hash = match String.index_opt name '-' with
268
-
| Some i -> String.sub name (i + 1) (String.length name - i - 1)
269
-
| None -> name
270
-
in
271
-
let created = if String.length m.created_at >= 19
272
-
then String.sub m.created_at 0 19 else m.created_at in
273
-
Printf.printf "%-14s %-9s %-8s %-19s %d deps\n"
274
-
(short hash) (kind_of m) (status_of m) created (List.length m.deps)
275
-
) entries;
276
-
0
277
-
end
278
-
279
-
(* ── log ─────────────────────────────────────────────────────────────── *)
277
+
(* ── log ─────────────────────────────────────────────────────────── *)
280
278
281
279
let cmd_log os_dir hash_prefix =
282
-
let os_dir = fpath os_dir in
283
-
match find_layer_by_prefix os_dir hash_prefix with
284
-
| [] -> Printf.eprintf "No layer with hash prefix %s\n" hash_prefix; 1
285
-
| _ :: _ :: _ as ms ->
286
-
Printf.eprintf "Ambiguous prefix:\n";
287
-
List.iter (fun (n, _) -> Printf.eprintf " %s\n" n) ms; 2
288
-
| [ (_name, layer_dir) ] ->
289
-
let log_path = Fpath.(layer_dir / "layer.log") in
290
-
match Bos.OS.File.read log_path with
291
-
| Ok content -> print_string content; 0
292
-
| Error (`Msg e) -> Printf.eprintf "%s\n" e; 1
280
+
with_resolved_layer os_dir hash_prefix @@ fun _os_dir _name layer_dir ->
281
+
let log_path = Fpath.(layer_dir / "layer.log") in
282
+
match Bos.OS.File.read log_path with
283
+
| Ok content -> print_string content; 0
284
+
| Error (`Msg e) -> Printf.eprintf "%s\n" e; 1
293
285
294
-
(* ── CLI wiring ──────────────────────────────────────────────────────── *)
286
+
(* ── CLI wiring ──────────────────────────────────────────────────── *)
295
287
296
288
let os_dir_term =
297
289
let doc = "Path to the OS-specific cache directory containing build-* \
298
-
subdirectories (e.g. /home/jjl25/cache/debian-bookworm-x86_64)" in
290
+
subdirectories" in
299
291
Arg.(required & opt (some string) None
300
292
& info [ "os-dir" ] ~docv:"DIR" ~doc)
301
-
302
-
let kind_term =
303
-
let doc = "Filter by layer kind (build, compile, link, doc-all)" in
304
-
Arg.(value & opt (some string) None & info [ "kind"; "k" ] ~docv:"KIND" ~doc)
305
293
306
294
let status_term =
307
295
let doc = "Filter by status (ok, fail, cascade)" in
308
296
Arg.(value & opt (some string) None
309
297
& info [ "status"; "s" ] ~docv:"STATUS" ~doc)
310
298
311
-
let pkg_filter_term =
312
-
let doc = "Filter by package name (substring match)" in
313
-
Arg.(value & opt (some string) None & info [ "package"; "p" ] ~docv:"PKG" ~doc)
299
+
let has_term =
300
+
let doc = "Filter to layers that have a file of this name in their \
301
+
directory. Repeatable — all specified files must be \
302
+
present. Use e.g. [--has build.json] to find opam build \
303
+
layers, [--has doc.json] for doc layers." in
304
+
Arg.(value & opt_all string [] & info [ "has" ] ~docv:"FILE" ~doc)
314
305
315
306
let limit_term =
316
307
let doc = "Limit number of results" in
317
308
Arg.(value & opt (some int) None & info [ "limit"; "n" ] ~docv:"N" ~doc)
318
309
319
310
let sort_lru_term =
320
-
let doc = "Sort by last-used time, oldest first \
321
-
(layers never accessed appear first as 'never'). \
322
-
Useful for finding LRU eviction candidates." in
311
+
let doc = "Sort by last-used time, oldest first" in
323
312
Arg.(value & flag & info [ "sort-by-lru"; "lru" ] ~doc)
324
313
325
314
let hash_term =
326
315
Arg.(required & pos 0 (some string) None
327
316
& info [] ~docv:"HASH" ~doc:"Layer hash (or prefix)")
328
317
329
-
let pkg_term =
330
-
Arg.(required & pos 0 (some string) None
331
-
& info [] ~docv:"PACKAGE"
332
-
~doc:"Exact package name with version (e.g. zarith.1.14)")
333
-
334
318
let list_cmd =
335
319
let info = Cmd.info "list" ~doc:"List layers in the cache" in
336
-
Cmd.v info Term.(const cmd_list $ os_dir_term $ kind_term
337
-
$ status_term $ pkg_filter_term $ limit_term
338
-
$ sort_lru_term)
320
+
Cmd.v info Term.(const cmd_list $ os_dir_term $ status_term
321
+
$ has_term $ limit_term $ sort_lru_term)
339
322
340
323
let show_cmd =
341
-
let info = Cmd.info "show" ~doc:"Show full metadata for one layer" in
324
+
let info = Cmd.info "show"
325
+
~doc:"Show layer.json contents and list of extra files" in
342
326
Cmd.v info Term.(const cmd_show $ os_dir_term $ hash_term)
343
327
344
328
let tree_cmd =
345
-
let info = Cmd.info "tree" ~doc:"Show dependency tree of a layer" in
329
+
let info = Cmd.info "tree"
330
+
~doc:"Show parent tree of a layer (follows parent_hashes)" in
346
331
Cmd.v info Term.(const cmd_tree $ os_dir_term $ hash_term)
347
332
348
333
let stats_cmd =
349
-
let info = Cmd.info "stats" ~doc:"Summary statistics of the cache" in
334
+
let info = Cmd.info "stats"
335
+
~doc:"Summary: total count, disk usage, breakdown by status and \
336
+
extra-file set" in
350
337
Cmd.v info Term.(const cmd_stats $ os_dir_term)
351
338
352
-
let package_cmd =
353
-
let info = Cmd.info "package" ~doc:"List all layers for one package" in
354
-
Cmd.v info Term.(const cmd_package $ os_dir_term $ pkg_term)
355
-
356
339
let log_cmd =
357
-
let info = Cmd.info "log" ~doc:"Print the build log for a layer" in
340
+
let info = Cmd.info "log"
341
+
~doc:"Print the layer's build log (layer.log)" in
358
342
Cmd.v info Term.(const cmd_log $ os_dir_term $ hash_term)
359
343
360
344
let main =
361
345
let info = Cmd.info "day11-layer-cli"
362
-
~doc:"Low-level inspection of the day11 layer cache"
363
-
~version:"0.1" in
364
-
Cmd.group info [ list_cmd; show_cmd; tree_cmd; stats_cmd;
365
-
package_cmd; log_cmd ]
346
+
~doc:"Low-level inspection of the day11 layer cache. Strictly \
347
+
generic: knows about layer.json and the filesystem layout, \
348
+
but treats domain-specific sidecar files as opaque JSON \
349
+
blobs (which it pretty-prints in 'show')."
350
+
~version:"0.3" in
351
+
Cmd.group info [ list_cmd; show_cmd; tree_cmd; stats_cmd; log_cmd ]
366
352
367
353
let () = exit (Cmd.eval' main)
+5
day11/layer/dir.ml
+5
day11/layer/dir.ml
+18
day11/layer/dir.mli
+18
day11/layer/dir.mli
···
1
+
(** On-disk layer directory naming convention.
2
+
3
+
All layers, regardless of kind (opam build, doc, future), live in
4
+
a directory whose name is derived from the layer's content hash.
5
+
This module owns that convention so individual kinds don't have
6
+
to know it. *)
7
+
8
+
val name : string -> string
9
+
(** [name hash] returns the directory basename for a layer with full
10
+
content hash [hash]. The first 12 hex characters are used and
11
+
prefixed with ["build-"], producing e.g. ["build-c9f7404f9f87"].
12
+
13
+
The ["build-"] prefix is historical: it was originally only used
14
+
for opam package build layers, but the same naming applies to
15
+
every layer kind now. *)
16
+
17
+
val path : os_dir:Fpath.t -> string -> Fpath.t
18
+
(** [path ~os_dir hash] is [os_dir / name hash]. *)
+1
-1
day11/layer/dune
+1
-1
day11/layer/dune
day11/layer/installed_files.ml
day11/opam_layer/installed_files.ml
day11/layer/installed_files.ml
day11/opam_layer/installed_files.ml
day11/layer/installed_files.mli
day11/opam_layer/installed_files.mli
day11/layer/installed_files.mli
day11/opam_layer/installed_files.mli
+1
-1
day11/layer/last_used.mli
+1
-1
day11/layer/last_used.mli
···
4
4
mtime records the most recent access. The file's content is
5
5
irrelevant — only its mtime matters.
6
6
7
-
This is deliberately split off from {!Layer_meta} so that marking
7
+
This is deliberately split off from {!Meta} so that marking
8
8
a layer as used is cheap — just [utimensat] on a small sentinel
9
9
file, no JSON read/write. *)
10
10
-168
day11/layer/layer_meta.ml
-168
day11/layer/layer_meta.ml
···
1
-
(* ── Layer kind ───────────────────────────────────────────────── *)
2
-
3
-
type kind = Build | Compile | Link | Doc_all
4
-
5
-
let string_of_kind = function
6
-
| Build -> "build"
7
-
| Compile -> "compile"
8
-
| Link -> "link"
9
-
| Doc_all -> "doc-all"
10
-
11
-
let kind_of_string = function
12
-
| "build" -> Build
13
-
| "compile" -> Compile
14
-
| "link" -> Link
15
-
| "doc-all" -> Doc_all
16
-
| _ -> Build (* unknown kinds fall back to Build for forward-compat *)
17
-
18
-
(* ── Phase timing ─────────────────────────────────────────────── *)
19
-
20
-
type timing = (string * float) list
21
-
22
-
let empty_timing : timing = []
23
-
24
-
let timing_field name t =
25
-
try List.assoc name t with Not_found -> 0.0
26
-
27
-
(* Serialize as a JSON object. A ppx_deriving_yojson [@of_yojson]
28
-
/ [@to_yojson] on the wire record will use these. *)
29
-
let timing_to_yojson (t : timing) : Yojson.Safe.t =
30
-
`Assoc (List.map (fun (k, v) -> (k, `Float v)) t)
31
-
32
-
let timing_of_yojson (json : Yojson.Safe.t) : (timing, string) result =
33
-
match json with
34
-
| `Assoc kvs ->
35
-
(try
36
-
Ok (List.map (fun (k, v) ->
37
-
match v with
38
-
| `Float f -> (k, f)
39
-
| `Int i -> (k, float_of_int i)
40
-
| _ -> failwith "timing value must be a number") kvs)
41
-
with Failure m -> Error m)
42
-
| `Null -> Ok []
43
-
| _ -> Error "timing must be a JSON object"
44
-
45
-
(* ── Build metadata ───────────────────────────────────────────── *)
46
-
47
-
(* Internal "wire" record mirrors the on-disk JSON with kind as a
48
-
string. The public [build_meta] type uses the typed [kind] and
49
-
conversions happen in save/load. *)
50
-
type build_meta_wire = {
51
-
package : string;
52
-
kind : string; [@default "build"]
53
-
exit_status : int;
54
-
deps : string list;
55
-
hashes : string list;
56
-
uid : int;
57
-
gid : int;
58
-
base_hash : string;
59
-
installed_libs : string list; [@default []]
60
-
installed_docs : string list; [@default []]
61
-
patches : string list; [@default []]
62
-
failed_dep : string option; [@default None]
63
-
disk_usage : int; [@default 0]
64
-
timing : timing; [@default empty_timing]
65
-
created_at : string;
66
-
} [@@deriving yojson]
67
-
68
-
type build_meta = {
69
-
package : string;
70
-
kind : kind;
71
-
exit_status : int;
72
-
deps : string list;
73
-
hashes : string list;
74
-
uid : int;
75
-
gid : int;
76
-
base_hash : string;
77
-
installed_libs : string list;
78
-
installed_docs : string list;
79
-
patches : string list;
80
-
failed_dep : string option;
81
-
disk_usage : int;
82
-
timing : timing;
83
-
created_at : string;
84
-
}
85
-
86
-
let wire_of_meta (m : build_meta) : build_meta_wire =
87
-
{ package = m.package; kind = string_of_kind m.kind;
88
-
exit_status = m.exit_status; deps = m.deps; hashes = m.hashes;
89
-
uid = m.uid; gid = m.gid; base_hash = m.base_hash;
90
-
installed_libs = m.installed_libs; installed_docs = m.installed_docs;
91
-
patches = m.patches; failed_dep = m.failed_dep;
92
-
disk_usage = m.disk_usage; timing = m.timing;
93
-
created_at = m.created_at }
94
-
95
-
let meta_of_wire (w : build_meta_wire) : build_meta =
96
-
{ package = w.package; kind = kind_of_string w.kind;
97
-
exit_status = w.exit_status; deps = w.deps; hashes = w.hashes;
98
-
uid = w.uid; gid = w.gid; base_hash = w.base_hash;
99
-
installed_libs = w.installed_libs; installed_docs = w.installed_docs;
100
-
patches = w.patches; failed_dep = w.failed_dep;
101
-
disk_usage = w.disk_usage; timing = w.timing;
102
-
created_at = w.created_at }
103
-
104
-
(* ── (de)serialization plumbing ───────────────────────────────── *)
105
-
106
-
let now_iso8601 () =
107
-
let t = Unix.gettimeofday () in
108
-
let tm = Unix.gmtime t in
109
-
Printf.sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ"
110
-
(tm.tm_year + 1900) (tm.tm_mon + 1) tm.tm_mday
111
-
tm.tm_hour tm.tm_min tm.tm_sec
112
-
113
-
let save_json path json =
114
-
try
115
-
Yojson.Safe.to_file (Fpath.to_string path) json;
116
-
Ok ()
117
-
with exn ->
118
-
Rresult.R.error_msgf "save %a: %s" Fpath.pp path (Printexc.to_string exn)
119
-
120
-
let load_json path =
121
-
try Ok (Yojson.Safe.from_file (Fpath.to_string path))
122
-
with exn ->
123
-
Rresult.R.error_msgf "load %a: %s" Fpath.pp path (Printexc.to_string exn)
124
-
125
-
let save_build ?created_at path meta =
126
-
let created_at = match created_at with
127
-
| Some s -> s
128
-
| None ->
129
-
if meta.created_at = "" then now_iso8601 () else meta.created_at
130
-
in
131
-
let meta = { meta with created_at } in
132
-
save_json path (build_meta_wire_to_yojson (wire_of_meta meta))
133
-
134
-
let load_build path =
135
-
match load_json path with
136
-
| Error _ as e -> e
137
-
| Ok json ->
138
-
match build_meta_wire_of_yojson json with
139
-
| Ok w -> Ok (meta_of_wire w)
140
-
| Error msg -> Rresult.R.error_msgf "load_build %a: %s" Fpath.pp path msg
141
-
142
-
let load_build_tree ~os_dir hash =
143
-
let cache : (string, Layer_type.build) Hashtbl.t = Hashtbl.create 16 in
144
-
let ( let* ) r f = match r with Ok v -> f v | Error _ as e -> e in
145
-
let rec load h =
146
-
match Hashtbl.find_opt cache h with
147
-
| Some b -> Ok b
148
-
| None ->
149
-
let dir_name = "build-" ^ String.sub h 0 12 in
150
-
let layer_json = Fpath.(os_dir / dir_name / "layer.json") in
151
-
let* meta = load_build layer_json in
152
-
let* deps = load_deps meta.hashes in
153
-
let build : Layer_type.build = {
154
-
hash = h;
155
-
pkg = OpamPackage.of_string meta.package;
156
-
deps;
157
-
universe = Day11_graph.Universe.dummy;
158
-
} in
159
-
Hashtbl.replace cache h build;
160
-
Ok build
161
-
and load_deps hashes =
162
-
List.fold_left (fun acc h ->
163
-
let* acc = acc in
164
-
let* dep = load h in
165
-
Ok (acc @ [ dep ])
166
-
) (Ok []) hashes
167
-
in
168
-
load hash
-80
day11/layer/layer_meta.mli
-80
day11/layer/layer_meta.mli
···
1
-
(** Layer metadata types with JSON serialization.
2
-
3
-
Each layer has a [layer.json] file containing a {!build_meta}
4
-
record. Readers use {!load_build}; writers use {!save_build}.
5
-
Round-trip is via an internal wire record so that the public
6
-
type can use typed variants (e.g. {!kind}) while the on-disk
7
-
format stays as plain JSON.
8
-
9
-
LRU access bookkeeping is deliberately split off into
10
-
{!Last_used} so that marking a layer as used doesn't require
11
-
rewriting its JSON. *)
12
-
13
-
(** {2 Layer kind} *)
14
-
15
-
type kind =
16
-
| Build (** Package build output (upper of a container build) *)
17
-
| Compile (** odoc compile phase *)
18
-
| Link (** odoc link phase *)
19
-
| Doc_all (** odoc compile+link+html in one shot *)
20
-
(** Layer kind. On disk, encoded as the string ["build"], ["compile"],
21
-
["link"], or ["doc-all"]. Unknown strings round-trip as {!Build}. *)
22
-
23
-
val string_of_kind : kind -> string
24
-
val kind_of_string : string -> kind
25
-
26
-
(** {2 Phase timing} *)
27
-
28
-
type timing = (string * float) list
29
-
(** Timing breakdown for a layer build, as an ordered list of
30
-
[(phase_name, seconds)] pairs. On disk, serialized as a JSON
31
-
object where each phase name is a key with a numeric value.
32
-
33
-
The schema is open: callers may record whatever phases they
34
-
find useful (e.g. ["merge"], ["runc_run"], ["total"]) and
35
-
readers should treat unknown phases as opaque. *)
36
-
37
-
val empty_timing : timing
38
-
(** The empty timing list. *)
39
-
40
-
val timing_field : string -> timing -> float
41
-
(** [timing_field name t] returns the value for phase [name] in [t],
42
-
or [0.0] if absent. Convenience for readers that want a specific
43
-
well-known phase. *)
44
-
45
-
(** {2 Build metadata record} *)
46
-
47
-
type build_meta = {
48
-
package : string;
49
-
kind : kind;
50
-
exit_status : int;
51
-
deps : string list;
52
-
hashes : string list;
53
-
uid : int;
54
-
gid : int;
55
-
base_hash : string;
56
-
installed_libs : string list;
57
-
installed_docs : string list;
58
-
patches : string list;
59
-
failed_dep : string option;
60
-
disk_usage : int;
61
-
timing : timing;
62
-
created_at : string;
63
-
}
64
-
65
-
val save_build :
66
-
?created_at:string ->
67
-
Fpath.t -> build_meta -> (unit, [> Rresult.R.msg ]) result
68
-
(** [save_build path meta] writes [meta] to [path] as JSON. If
69
-
[?created_at] is supplied, it overrides [meta.created_at];
70
-
if omitted and [meta.created_at] is empty, the current time
71
-
(UTC ISO-8601) is used. *)
72
-
73
-
val load_build : Fpath.t -> (build_meta, [> Rresult.R.msg ]) result
74
-
75
-
val load_build_tree :
76
-
os_dir:Fpath.t -> string ->
77
-
(Layer_type.build, [> Rresult.R.msg ]) result
78
-
(** [load_build_tree ~os_dir hash] reconstructs a {!Layer_type.build}
79
-
tree by recursively reading [layer.json] files from [os_dir].
80
-
The [hash] is the full hash (not truncated). *)
-25
day11/layer/layer_type.ml
-25
day11/layer/layer_type.ml
···
1
-
type base = {
2
-
hash : string;
3
-
dir : Fpath.t;
4
-
image : string;
5
-
}
6
-
7
-
type build = {
8
-
hash : string;
9
-
pkg : OpamPackage.t;
10
-
deps : build list;
11
-
universe : Day11_graph.Universe.t;
12
-
}
13
-
14
-
type tool = {
15
-
hash : string;
16
-
dir : Fpath.t;
17
-
builds : build list;
18
-
}
19
-
20
-
let build_dir_name (b : build) =
21
-
"build-" ^ String.sub b.hash 0 12
22
-
23
-
let build_dir ~os_dir (b : build) =
24
-
Fpath.(os_dir / build_dir_name b)
25
-
-41
day11/layer/layer_type.mli
-41
day11/layer/layer_type.mli
···
1
-
(** Layer types for build DAGs.
2
-
3
-
{!build} is a recursive type that represents both the plan (before
4
-
building) and the result (after building). Paths on disk are derived
5
-
from hashes.
6
-
7
-
{!base} and {!tool} are non-recursive inputs to the DAG. *)
8
-
9
-
(** {2 Base layer} *)
10
-
11
-
type base = {
12
-
hash : string;
13
-
dir : Fpath.t;
14
-
image : string;
15
-
}
16
-
17
-
(** {2 Build layer} *)
18
-
19
-
type build = {
20
-
hash : string;
21
-
pkg : OpamPackage.t;
22
-
deps : build list;
23
-
universe : Day11_graph.Universe.t;
24
-
}
25
-
(** Path on disk: [os_dir / build_dir_name build].
26
-
[universe] identifies which solution universe this node
27
-
belongs to. *)
28
-
29
-
(** {2 Tool layer} *)
30
-
31
-
type tool = {
32
-
hash : string;
33
-
dir : Fpath.t;
34
-
builds : build list;
35
-
}
36
-
37
-
(** {2 Path derivation} *)
38
-
39
-
val build_dir_name : build -> string
40
-
val build_dir : os_dir:Fpath.t -> build -> Fpath.t
41
-
+76
day11/layer/meta.ml
+76
day11/layer/meta.ml
···
1
+
(* ── Phase timing ─────────────────────────────────────────────── *)
2
+
3
+
type timing = (string * float) list
4
+
5
+
let empty_timing : timing = []
6
+
7
+
let timing_field name t =
8
+
try List.assoc name t with Not_found -> 0.0
9
+
10
+
let timing_to_yojson (t : timing) : Yojson.Safe.t =
11
+
`Assoc (List.map (fun (k, v) -> (k, `Float v)) t)
12
+
13
+
let timing_of_yojson (json : Yojson.Safe.t) : (timing, string) result =
14
+
match json with
15
+
| `Assoc kvs ->
16
+
(try
17
+
Ok (List.map (fun (k, v) ->
18
+
match v with
19
+
| `Float f -> (k, f)
20
+
| `Int i -> (k, float_of_int i)
21
+
| _ -> failwith "timing value must be a number") kvs)
22
+
with Failure m -> Error m)
23
+
| `Null -> Ok []
24
+
| _ -> Error "timing must be a JSON object"
25
+
26
+
(* ── Layer metadata ────────────────────────────────────────────── *)
27
+
28
+
type t = {
29
+
exit_status : int;
30
+
parent_hashes : string list; [@default []]
31
+
uid : int;
32
+
gid : int;
33
+
base_hash : string;
34
+
disk_usage : int; [@default 0]
35
+
timing : timing; [@default empty_timing]
36
+
created_at : string;
37
+
failed_dep : string option; [@default None]
38
+
} [@@deriving yojson { strict = false }]
39
+
40
+
(* ── (de)serialization ────────────────────────────────────────── *)
41
+
42
+
let now_iso8601 () =
43
+
let t = Unix.gettimeofday () in
44
+
let tm = Unix.gmtime t in
45
+
Printf.sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ"
46
+
(tm.tm_year + 1900) (tm.tm_mon + 1) tm.tm_mday
47
+
tm.tm_hour tm.tm_min tm.tm_sec
48
+
49
+
let save_json path json =
50
+
try
51
+
Yojson.Safe.to_file (Fpath.to_string path) json;
52
+
Ok ()
53
+
with exn ->
54
+
Rresult.R.error_msgf "save %a: %s" Fpath.pp path (Printexc.to_string exn)
55
+
56
+
let load_json path =
57
+
try Ok (Yojson.Safe.from_file (Fpath.to_string path))
58
+
with exn ->
59
+
Rresult.R.error_msgf "load %a: %s" Fpath.pp path (Printexc.to_string exn)
60
+
61
+
let save ?created_at path t =
62
+
let created_at = match created_at with
63
+
| Some s -> s
64
+
| None ->
65
+
if t.created_at = "" then now_iso8601 () else t.created_at
66
+
in
67
+
let t = { t with created_at } in
68
+
save_json path (to_yojson t)
69
+
70
+
let load path =
71
+
match load_json path with
72
+
| Error _ as e -> e
73
+
| Ok json ->
74
+
match of_yojson json with
75
+
| Ok v -> Ok v
76
+
| Error msg -> Rresult.R.error_msgf "load %a: %s" Fpath.pp path msg
+79
day11/layer/meta.mli
+79
day11/layer/meta.mli
···
1
+
(** Generic per-layer metadata, serialized as [layer.json].
2
+
3
+
Every layer of every kind has a [layer.json] file holding a
4
+
{!t} record. The record contains only information that is
5
+
meaningful for any layer regardless of what built it: how the
6
+
container exited, which parents it stacked on, who the build
7
+
user was, what time it took, when it was created.
8
+
9
+
{1 Sidecar convention}
10
+
11
+
Domain-specific information (the package being built, installed
12
+
files, applied patches, odoc phase, etc.) lives in {b sidecar}
13
+
files in the same directory and is owned by the relevant domain
14
+
library. The "kind" of a layer is determined by which sidecar
15
+
files are present:
16
+
17
+
- [build.json] (see [Day11_opam_layer.Build_meta]) marks an
18
+
opam package build layer
19
+
- [doc.json] (see [Day11_opam_layer.Doc_meta]) marks an odoc
20
+
doc layer
21
+
- future kinds add their own sidecars
22
+
23
+
{b Sidecar files MUST be valid JSON} (typically a single object
24
+
at the top level). The generic library does not enforce this —
25
+
no part of [day11_layer] reads sidecars — but tools that walk
26
+
the cache rely on the convention to display layer contents
27
+
without needing the relevant domain library linked in.
28
+
29
+
LRU access bookkeeping is kept separate — see {!Last_used} — so
30
+
touching a layer doesn't rewrite its JSON.
31
+
32
+
{1 Phase timing}
33
+
34
+
Build pipelines record per-phase timing as a free-form
35
+
[(string * float) list]. Phase names are not validated; readers
36
+
that want a specific well-known phase use {!timing_field}. *)
37
+
38
+
type timing = (string * float) list
39
+
40
+
val empty_timing : timing
41
+
val timing_field : string -> timing -> float
42
+
43
+
(** {1 Layer metadata} *)
44
+
45
+
type t = {
46
+
exit_status : int;
47
+
(** Exit status of the build process: 0 = success, anything else
48
+
is a failure. *)
49
+
parent_hashes : string list;
50
+
(** Full hashes of the layers that were stacked as the lowers of
51
+
the overlay during the build, in the order they were stacked.
52
+
For domain types that also carry their own dep records (e.g.
53
+
opam package strings), the parallel list lives in the sidecar. *)
54
+
uid : int;
55
+
gid : int;
56
+
base_hash : string;
57
+
(** Hash of the base image layer at the bottom of the overlay. *)
58
+
disk_usage : int;
59
+
(** Approximate size in bytes of the layer's [fs/] tree. *)
60
+
timing : timing;
61
+
created_at : string;
62
+
(** ISO-8601 UTC timestamp of when the layer was extracted. *)
63
+
failed_dep : string option;
64
+
(** [Some name] for layers that didn't run because a dependency
65
+
build failed. [None] for layers that ran to completion (whether
66
+
successfully or with a non-zero exit). *)
67
+
}
68
+
69
+
(** {1 Read and write} *)
70
+
71
+
val save :
72
+
?created_at:string ->
73
+
Fpath.t -> t -> (unit, [> Rresult.R.msg ]) result
74
+
(** [save path t] writes [t] to [path] as JSON. If [?created_at]
75
+
is supplied, it overrides [t.created_at]; if omitted and
76
+
[t.created_at] is empty, the current UTC time is used. *)
77
+
78
+
val load : Fpath.t -> (t, [> Rresult.R.msg ]) result
79
+
(** [load path] reads and parses a [layer.json]. *)
day11/layer/opam_repo.ml
day11/opam_layer/opam_repo.ml
day11/layer/opam_repo.ml
day11/opam_layer/opam_repo.ml
day11/layer/opam_repo.mli
day11/opam_layer/opam_repo.mli
day11/layer/opam_repo.mli
day11/opam_layer/opam_repo.mli
day11/layer/opamh.ml
day11/opam_layer/opamh.ml
day11/layer/opamh.ml
day11/opam_layer/opamh.ml
day11/layer/opamh.mli
day11/opam_layer/opamh.mli
day11/layer/opamh.mli
day11/opam_layer/opamh.mli
-16
day11/layer/package_symlinks.ml
-16
day11/layer/package_symlinks.ml
···
1
-
let ensure_layer_symlink ~packages_dir ~pkg_str ~layer_name =
2
-
let pkg_dir = Fpath.(packages_dir / pkg_str) in
3
-
let symlink_path = Fpath.(pkg_dir / layer_name) in
4
-
let target = Filename.concat ".." (Filename.concat ".." layer_name) in
5
-
try
6
-
Bos.OS.Dir.create ~path:true pkg_dir |> ignore;
7
-
(* Remove existing symlink and recreate — ensures it points to
8
-
the latest build, not just the first one ever created *)
9
-
(try Unix.unlink (Fpath.to_string symlink_path)
10
-
with Unix.Unix_error (Unix.ENOENT, _, _) -> ());
11
-
(try Unix.symlink target (Fpath.to_string symlink_path)
12
-
with Unix.Unix_error (Unix.EEXIST, _, _) -> ());
13
-
Ok ()
14
-
with exn ->
15
-
Rresult.R.error_msgf "ensure_layer_symlink %s/%s: %s"
16
-
pkg_str layer_name (Printexc.to_string exn)
-15
day11/layer/package_symlinks.mli
-15
day11/layer/package_symlinks.mli
···
1
-
(** Per-package tracking symlinks.
2
-
3
-
Each package has a directory under [packages_dir/{pkg_str}/] that
4
-
contains symlinks pointing back to layer directories. This enables
5
-
tracking all layers for a given package. *)
6
-
7
-
val ensure_layer_symlink :
8
-
packages_dir:Fpath.t ->
9
-
pkg_str:string ->
10
-
layer_name:string ->
11
-
(unit, [> Rresult.R.msg ]) result
12
-
(** [ensure_layer_symlink ~packages_dir ~pkg_str ~layer_name] creates
13
-
a symlink at [packages_dir/pkg_str/layer_name] pointing to
14
-
[../../layer_name]. Creates the package directory if needed.
15
-
Idempotent — silently succeeds if the symlink already exists. *)
+16
day11/layer/symlinks.ml
+16
day11/layer/symlinks.ml
···
1
+
let ensure ~packages_dir ~id ~layer_name =
2
+
let id_dir = Fpath.(packages_dir / id) in
3
+
let symlink_path = Fpath.(id_dir / layer_name) in
4
+
let target = Filename.concat ".." (Filename.concat ".." layer_name) in
5
+
try
6
+
Bos.OS.Dir.create ~path:true id_dir |> ignore;
7
+
(* Remove existing symlink and recreate — ensures it points to
8
+
the latest build, not just the first one ever created *)
9
+
(try Unix.unlink (Fpath.to_string symlink_path)
10
+
with Unix.Unix_error (Unix.ENOENT, _, _) -> ());
11
+
(try Unix.symlink target (Fpath.to_string symlink_path)
12
+
with Unix.Unix_error (Unix.EEXIST, _, _) -> ());
13
+
Ok ()
14
+
with exn ->
15
+
Rresult.R.error_msgf "Symlinks.ensure %s/%s: %s"
16
+
id layer_name (Printexc.to_string exn)
+23
day11/layer/symlinks.mli
+23
day11/layer/symlinks.mli
···
1
+
(** Per-id tracking symlinks under [packages_dir/<id>/].
2
+
3
+
A small registry that lets you enumerate every layer ever
4
+
associated with a given identifier (typically a package
5
+
[name.version] string, but the function is generic — any string
6
+
that's a valid path component will do).
7
+
8
+
For each layer, a symlink is created at
9
+
[packages_dir/<id>/<layer_name>] pointing back to the layer
10
+
directory. The directory name [packages] is historical from when
11
+
every layer was an opam package build; this module just owns the
12
+
symlink mechanics and does not interpret the namespace. *)
13
+
14
+
val ensure :
15
+
packages_dir:Fpath.t ->
16
+
id:string ->
17
+
layer_name:string ->
18
+
(unit, [> Rresult.R.msg ]) result
19
+
(** [ensure ~packages_dir ~id ~layer_name] creates a symlink at
20
+
[packages_dir/id/layer_name] pointing to [../../layer_name].
21
+
Creates the [packages_dir/id] directory if needed. Idempotent —
22
+
if a symlink already exists at the same path it is replaced so
23
+
the registry always reflects the most recent build. *)
+1
-1
day11/layer/test/dune
+1
-1
day11/layer/test/dune
+40
-154
day11/layer/test/test_layer.ml
+40
-154
day11/layer/test/test_layer.ml
···
1
-
(* Tests for the day11_layer library. *)
1
+
(* Tests for the day11_layer library (generic, no opam). *)
2
2
3
3
open Day11_layer
4
4
open Day11_test_util.Test_util
5
-
6
-
(* ── Helpers ─────────────────────────────────────────────────────── *)
7
5
8
6
let is_ok msg r = ok_or_fail msg r |> ignore
9
7
10
-
let pkg_list ss = List.map OpamPackage.of_string ss
11
-
12
-
(* ── Layer_meta tests ────────────────────────────────────────────── *)
8
+
(* ── Meta tests ────────────────────────────────────────────── *)
13
9
14
10
let test_layer_meta_roundtrip () = with_tmp_dir @@ fun dir ->
15
11
let path = Fpath.(dir / "layer.json") in
16
-
let meta : Layer_meta.build_meta = {
17
-
package = "broken.1.0"; kind = Layer_meta.Build; exit_status = -1;
18
-
deps = ["ocaml.5.4.1"]; hashes = ["build-abc123"];
19
-
uid = 1000; gid = 1000; base_hash = "test";
20
-
installed_libs = []; installed_docs = []; patches = []; failed_dep = None;
21
-
disk_usage = 0; timing = Layer_meta.empty_timing;
12
+
let meta : Meta.t = {
13
+
exit_status = -1;
14
+
parent_hashes = [ "abc123"; "def456" ];
15
+
uid = 1000; gid = 1000;
16
+
base_hash = "test";
17
+
disk_usage = 0;
18
+
timing = Meta.empty_timing;
22
19
created_at = "2024-01-01T00:00:00Z";
20
+
failed_dep = None;
23
21
} in
24
-
Layer_meta.save_build path meta |> is_ok "save";
25
-
let m = Layer_meta.load_build path |> ok_or_fail "load" in
22
+
Meta.save path meta |> is_ok "save";
23
+
let m = Meta.load path |> ok_or_fail "load" in
26
24
Alcotest.(check int) "exit_status" (-1) m.exit_status;
27
-
Alcotest.(check string) "package" "broken.1.0" m.package;
28
-
Alcotest.(check bool) "kind" true (m.kind = Layer_meta.Build)
25
+
Alcotest.(check (list string)) "parents"
26
+
[ "abc123"; "def456" ] m.parent_hashes
29
27
30
-
(* ── Package_symlinks tests ──────────────────────────────────────── *)
28
+
(* ── Dir tests ─────────────────────────────────────────────── *)
29
+
30
+
let test_layer_dir_name () =
31
+
Alcotest.(check string) "12-char hash"
32
+
"build-c9f7404f9f87"
33
+
(Dir.name "c9f7404f9f87a8b3c4d5e6f7");
34
+
Alcotest.(check string) "short hash"
35
+
"build-abc"
36
+
(Dir.name "abc")
37
+
38
+
(* ── Symlinks tests ────────────────────────────────────────── *)
31
39
32
40
let symlink_exists path =
33
41
try (Unix.lstat (Fpath.to_string path)).Unix.st_kind = Unix.S_LNK
···
35
43
36
44
let test_symlink_create () = with_tmp_dir @@ fun dir ->
37
45
let packages_dir = Fpath.(dir / "packages") in
38
-
Package_symlinks.ensure_layer_symlink
39
-
~packages_dir ~pkg_str:"yojson.2.2.2" ~layer_name:"build-abc123"
46
+
Symlinks.ensure
47
+
~packages_dir ~id:"yojson.2.2.2" ~layer_name:"build-abc123"
40
48
|> is_ok "create";
41
49
let link = Fpath.(packages_dir / "yojson.2.2.2" / "build-abc123") in
42
50
Alcotest.(check bool) "symlink exists" true (symlink_exists link)
43
51
44
52
let test_symlink_idempotent () = with_tmp_dir @@ fun dir ->
45
53
let packages_dir = Fpath.(dir / "packages") in
46
-
Package_symlinks.ensure_layer_symlink
47
-
~packages_dir ~pkg_str:"yojson.2.2.2" ~layer_name:"build-abc123"
54
+
Symlinks.ensure
55
+
~packages_dir ~id:"yojson.2.2.2" ~layer_name:"build-abc123"
48
56
|> is_ok "first";
49
-
Package_symlinks.ensure_layer_symlink
50
-
~packages_dir ~pkg_str:"yojson.2.2.2" ~layer_name:"build-abc123"
57
+
Symlinks.ensure
58
+
~packages_dir ~id:"yojson.2.2.2" ~layer_name:"build-abc123"
51
59
|> is_ok "second"
52
60
53
-
(* ── Installed_files tests ───────────────────────────────────────── *)
54
-
55
-
let test_scan_libs () = with_tmp_dir @@ fun dir ->
56
-
let lib_dir = Fpath.(dir / "fs" / "home" / "opam" / ".opam" / "default" / "lib" / "yojson") in
57
-
mkdir lib_dir;
58
-
write_file Fpath.(lib_dir / "yojson.cmi") "";
59
-
write_file Fpath.(lib_dir / "yojson.cmxa") "";
60
-
write_file Fpath.(lib_dir / "META") "";
61
-
write_file Fpath.(lib_dir / "README.md") "";
62
-
let files = Installed_files.scan_libs ~layer_dir:dir in
63
-
Alcotest.(check bool) "has cmi"
64
-
true (List.mem "yojson/yojson.cmi" files);
65
-
Alcotest.(check bool) "has META"
66
-
true (List.mem "yojson/META" files);
67
-
Alcotest.(check bool) "no README"
68
-
false (List.mem "yojson/README.md" files)
69
-
70
-
let test_scan_docs () = with_tmp_dir @@ fun dir ->
71
-
let doc_dir = Fpath.(dir / "fs" / "home" / "opam" / ".opam" / "default" / "doc" / "yojson") in
72
-
mkdir doc_dir;
73
-
write_file Fpath.(doc_dir / "index.mld") "";
74
-
write_file Fpath.(doc_dir / "odoc-config.sexp") "";
75
-
write_file Fpath.(doc_dir / "README") "";
76
-
let files = Installed_files.scan_docs ~layer_dir:dir in
77
-
Alcotest.(check bool) "has mld"
78
-
true (List.mem "yojson/index.mld" files);
79
-
Alcotest.(check bool) "has sexp"
80
-
true (List.mem "yojson/odoc-config.sexp" files);
81
-
Alcotest.(check bool) "no README"
82
-
false (List.mem "yojson/README" files)
83
-
84
-
let test_scan_empty_layer () = with_tmp_dir @@ fun dir ->
85
-
let files = Installed_files.scan_libs ~layer_dir:dir in
86
-
Alcotest.(check (list string)) "empty" [] files
87
-
88
-
(* ── Opam_repo tests ─────────────────────────────────────────────── *)
89
-
90
-
let test_opam_repo_create () = with_tmp_dir @@ fun dir ->
91
-
let repo_dir = Opam_repo.create dir |> ok_or_fail "create" in
92
-
Alcotest.(check bool) "repo file exists"
93
-
true (Bos.OS.File.exists Fpath.(repo_dir / "repo") |> Result.get_ok)
94
-
95
-
let test_opam_repo_populate () = with_tmp_dir @@ fun dir ->
96
-
let src_repo = Fpath.(dir / "opam-repo") in
97
-
let pkg_dir = Fpath.(src_repo / "packages" / "yojson" / "yojson.2.2.2") in
98
-
mkdir pkg_dir;
99
-
write_file Fpath.(pkg_dir / "opam") {|opam-version: "2.0"|};
100
-
let tgt_repo = Opam_repo.create dir |> ok_or_fail "create" in
101
-
Opam_repo.populate ~opam_repo:tgt_repo
102
-
~opam_repositories:[ src_repo ]
103
-
(pkg_list [ "yojson.2.2.2" ])
104
-
|> is_ok "populate";
105
-
let copied = Fpath.(tgt_repo / "packages" / "yojson" / "yojson.2.2.2" / "opam") in
106
-
Alcotest.(check bool) "opam file copied"
107
-
true (Bos.OS.File.exists copied |> Result.get_ok)
108
-
109
-
(* ── Skeleton (inline) tests ──────────────────────────────────────── *)
110
-
111
-
let write_skeleton ~layer_dir meta =
112
-
Bos.OS.Dir.create ~path:true layer_dir |> ignore;
113
-
Layer_meta.save_build Fpath.(layer_dir / "layer.json") meta
114
-
115
-
let test_skeleton_write () = with_tmp_dir @@ fun dir ->
116
-
let layer_dir = Fpath.(dir / "build-deadbeef") in
117
-
let meta : Layer_meta.build_meta = {
118
-
package = "yojson.2.2.2"; kind = Layer_meta.Build; exit_status = -1;
119
-
deps = ["dune.3.0"]; hashes = ["hash1"];
120
-
uid = 1000; gid = 1000; base_hash = "test";
121
-
installed_libs = []; installed_docs = []; patches = []; failed_dep = None;
122
-
disk_usage = 0; timing = Layer_meta.empty_timing;
123
-
created_at = "2024-01-01T00:00:00Z";
124
-
} in
125
-
write_skeleton ~layer_dir meta |> is_ok "write";
126
-
match Layer_meta.load_build Fpath.(layer_dir / "layer.json") with
127
-
| Ok m -> Alcotest.(check int) "exit_status" (-1) m.exit_status
128
-
| Error (`Msg e) -> Alcotest.fail e
129
-
130
61
(* ── Scan tests ──────────────────────────────────────────────────── *)
131
62
132
63
let test_list_layers () = with_tmp_dir @@ fun dir ->
···
182
113
with_tmp_dir @@ fun dir ->
183
114
let layer = Fpath.(dir / "build-abc") in
184
115
mkdir layer;
185
-
(* No fs/ subdir — should be skipped *)
186
116
let target = Fpath.(dir / "lower") in
187
117
mkdir target;
188
118
Stack.merge env ~layer_dirs:[ layer ] ~target |> is_ok "skip no fs"
189
119
190
120
let test_stack_single_layer () = with_eio @@ fun env ->
191
121
with_tmp_dir @@ fun dir ->
192
-
(* Create a layer with fs/ containing some files *)
193
122
let layer = Fpath.(dir / "build-aaa") in
194
123
mkdir Fpath.(layer / "fs" / "usr" / "lib");
195
124
write_file Fpath.(layer / "fs" / "usr" / "lib" / "libfoo.a") "content";
···
197
126
let target = Fpath.(dir / "lower") in
198
127
mkdir target;
199
128
Stack.merge env ~layer_dirs:[ layer ] ~target |> is_ok "merge";
200
-
(* Verify files appeared in target *)
201
129
Alcotest.(check bool) "hello.txt"
202
130
true (Bos.OS.File.exists Fpath.(target / "hello.txt") |> Result.get_ok);
203
131
Alcotest.(check bool) "nested file"
···
206
134
207
135
let test_stack_multiple_layers () = with_eio @@ fun env ->
208
136
with_tmp_dir @@ fun dir ->
209
-
(* Layer 1: provides base files *)
210
137
let layer1 = Fpath.(dir / "build-aaa") in
211
138
mkdir Fpath.(layer1 / "fs");
212
139
write_file Fpath.(layer1 / "fs" / "base.txt") "from-layer1";
213
140
write_file Fpath.(layer1 / "fs" / "shared.txt") "from-layer1";
214
-
(* Layer 2: provides additional files *)
215
141
let layer2 = Fpath.(dir / "build-bbb") in
216
142
mkdir Fpath.(layer2 / "fs");
217
143
write_file Fpath.(layer2 / "fs" / "extra.txt") "from-layer2";
···
219
145
let target = Fpath.(dir / "lower") in
220
146
mkdir target;
221
147
Stack.merge env ~layer_dirs:[ layer1; layer2 ] ~target |> is_ok "merge";
222
-
(* Both layers' unique files should be present *)
223
148
Alcotest.(check bool) "base.txt"
224
149
true (Bos.OS.File.exists Fpath.(target / "base.txt") |> Result.get_ok);
225
150
Alcotest.(check bool) "extra.txt"
226
151
true (Bos.OS.File.exists Fpath.(target / "extra.txt") |> Result.get_ok);
227
-
(* shared.txt: -n (no-clobber) means layer1 wins *)
228
152
let content = Bos.OS.File.read Fpath.(target / "shared.txt") |> Result.get_ok in
229
153
Alcotest.(check string) "first layer wins" "from-layer1" content
230
154
231
155
(* ── plan_lowerdir tests ─────────────────────────────────────────── *)
232
156
233
-
(** Build a long list of fake layer dirs all sharing a common prefix. *)
234
157
let fake_layers ~prefix n =
235
158
List.init n (fun i ->
236
159
Fpath.v (Printf.sprintf "%s/build-%012d" prefix i))
237
160
238
-
(** Cost helper matching what run_in_layers uses: path-to-fs-subdir
239
-
length plus one colon. *)
240
161
let entry_cost d =
241
162
String.length (Fpath.to_string Fpath.(d / "fs")) + 1
242
163
243
164
let test_plan_lowerdir_all_separate () =
244
-
(* Small dep set with short paths — everything should fit. *)
245
165
let layers = fake_layers ~prefix:"/c" 10 in
246
166
let separate, to_merge = Stack.plan_lowerdir
247
167
~available:3900 ~merged_overhead:30 ~entry_cost layers
···
250
170
Alcotest.(check int) "nothing to merge" 0 (List.length to_merge)
251
171
252
172
let test_plan_lowerdir_split () =
253
-
(* 200 fake layers with realistic-ish long paths. 200 × 63 = 12600
254
-
bytes, way over any reasonable budget — must split. *)
255
173
let prefix = "/home/jjl25/cache/debian-bookworm-x86_64" in
256
174
let layers = fake_layers ~prefix 200 in
257
175
let separate, to_merge = Stack.plan_lowerdir
···
261
179
(List.length separate + List.length to_merge);
262
180
Alcotest.(check bool) "did split" true (to_merge <> []);
263
181
Alcotest.(check bool) "kept some separate" true (separate <> []);
264
-
(* Check the invariant: sum of entry costs for separate + merged
265
-
overhead must be within available. *)
266
182
let sep_cost = List.fold_left (fun a d -> a + entry_cost d) 0 separate in
267
183
Alcotest.(check bool)
268
184
(Printf.sprintf "separate cost %d + merged %d ≤ available 3900"
···
277
193
Alcotest.(check int) "to_merge" 0 (List.length to_merge)
278
194
279
195
let test_plan_lowerdir_short_paths_no_split () =
280
-
(* With short /c paths and the usual budget, 150 deps fit. *)
281
196
let layers = fake_layers ~prefix:"/c" 150 in
282
197
let separate, to_merge = Stack.plan_lowerdir
283
198
~available:3900 ~merged_overhead:30 ~entry_cost layers
···
286
201
Alcotest.(check int) "no merge" 0 (List.length to_merge)
287
202
288
203
let test_plan_lowerdir_boundary () =
289
-
(* Exactly at the boundary: N entries × cost = available. Everything
290
-
should still fit (no merge) since the check is ≤, not <. *)
291
204
let layers = fake_layers ~prefix:"/c" 5 in
292
-
let per = entry_cost (List.hd layers) in (* 19 or so *)
205
+
let per = entry_cost (List.hd layers) in
293
206
let separate, to_merge = Stack.plan_lowerdir
294
207
~available:(5 * per) ~merged_overhead:1 ~entry_cost layers
295
208
in
296
209
Alcotest.(check int) "all fit at boundary" 5 (List.length separate);
297
210
Alcotest.(check int) "no merge" 0 (List.length to_merge);
298
-
(* One byte less: can't fit the last one. *)
299
211
let separate, to_merge = Stack.plan_lowerdir
300
212
~available:(5 * per - 1) ~merged_overhead:0 ~entry_cost layers
301
213
in
302
214
Alcotest.(check int) "one short" 4 (List.length separate);
303
215
Alcotest.(check int) "one merged" 1 (List.length to_merge)
304
216
305
-
(* ── Opamh tests ─────────────────────────────────────────────────── *)
306
-
307
-
let test_compiler_packages () =
308
-
let names = List.map OpamPackage.Name.to_string Opamh.compiler_packages in
309
-
Alcotest.(check bool) "has ocaml"
310
-
true (List.mem "ocaml" names);
311
-
Alcotest.(check bool) "has ocaml-base-compiler"
312
-
true (List.mem "ocaml-base-compiler" names)
313
-
314
217
(* ── Test registration ───────────────────────────────────────────── *)
315
218
316
219
let () =
317
220
Alcotest.run "day11_layer"
318
221
[
319
-
( "Layer_meta",
222
+
( "Meta",
320
223
[
321
224
Alcotest.test_case "roundtrip" `Quick test_layer_meta_roundtrip;
322
225
] );
323
-
( "Package_symlinks",
324
-
[
325
-
Alcotest.test_case "create" `Quick test_symlink_create;
326
-
Alcotest.test_case "idempotent" `Quick test_symlink_idempotent;
327
-
] );
328
-
( "Installed_files",
329
-
[
330
-
Alcotest.test_case "scan_libs" `Quick test_scan_libs;
331
-
Alcotest.test_case "scan_docs" `Quick test_scan_docs;
332
-
Alcotest.test_case "empty layer" `Quick test_scan_empty_layer;
333
-
] );
334
-
( "Opam_repo",
226
+
( "Dir",
335
227
[
336
-
Alcotest.test_case "create" `Quick test_opam_repo_create;
337
-
Alcotest.test_case "populate" `Quick test_opam_repo_populate;
228
+
Alcotest.test_case "name" `Quick test_layer_dir_name;
338
229
] );
339
-
( "Skeleton",
230
+
( "Symlinks",
340
231
[
341
-
Alcotest.test_case "write" `Quick test_skeleton_write;
232
+
Alcotest.test_case "create" `Quick test_symlink_create;
233
+
Alcotest.test_case "idempotent" `Quick test_symlink_idempotent;
342
234
] );
343
235
( "Scan",
344
236
[
···
349
241
( "Stack",
350
242
[
351
243
Alcotest.test_case "empty" `Quick test_stack_empty;
352
-
Alcotest.test_case "skips missing fs" `Quick
353
-
test_stack_skips_missing_fs;
244
+
Alcotest.test_case "skips missing fs" `Quick test_stack_skips_missing_fs;
354
245
Alcotest.test_case "single layer" `Quick test_stack_single_layer;
355
-
Alcotest.test_case "multiple layers" `Quick
356
-
test_stack_multiple_layers;
246
+
Alcotest.test_case "multiple layers" `Quick test_stack_multiple_layers;
357
247
Alcotest.test_case "plan_lowerdir all separate" `Quick
358
248
test_plan_lowerdir_all_separate;
359
249
Alcotest.test_case "plan_lowerdir split" `Quick
···
364
254
test_plan_lowerdir_short_paths_no_split;
365
255
Alcotest.test_case "plan_lowerdir boundary" `Quick
366
256
test_plan_lowerdir_boundary;
367
-
] );
368
-
( "Opamh",
369
-
[
370
-
Alcotest.test_case "compiler_packages" `Quick test_compiler_packages;
371
257
] );
372
258
]
+1
-1
day11/lib/dune
+1
-1
day11/lib/dune
+3
-3
day11/lib/run_log.ml
+3
-3
day11/lib/run_log.ml
···
194
194
| None -> ());
195
195
Mutex.unlock build_log_lock
196
196
197
-
let write_dag_structure run_info (nodes : Day11_layer.Layer_type.build list) =
197
+
let write_dag_structure run_info (nodes : Day11_opam_layer.Build.t list) =
198
198
let path = Filename.concat run_info.run_dir "dag_structure.jsonl" in
199
199
Out_channel.with_open_text path (fun oc ->
200
-
List.iter (fun (node : Day11_layer.Layer_type.build) ->
200
+
List.iter (fun (node : Day11_opam_layer.Build.t) ->
201
201
let json = `Assoc [
202
202
("hash", `String node.hash);
203
203
("pkg", `String (OpamPackage.to_string node.pkg));
204
-
("deps", `List (List.map (fun (dep : Day11_layer.Layer_type.build) ->
204
+
("deps", `List (List.map (fun (dep : Day11_opam_layer.Build.t) ->
205
205
`String dep.hash) node.deps));
206
206
] in
207
207
output_string oc (Yojson.Safe.to_string json);
+1
-1
day11/lib/run_log.mli
+1
-1
day11/lib/run_log.mli
···
52
52
[kind] is ["build"], ["tool"], ["doc-all"], ["compile"], or ["link"].
53
53
[layer_dir] is the path to the layer on disk. *)
54
54
55
-
val write_dag_structure : t -> Day11_layer.Layer_type.build list -> unit
55
+
val write_dag_structure : t -> Day11_opam_layer.Build.t list -> unit
56
56
(** Write one JSONL line per node: hash, package, dep hashes.
57
57
Enables offline analysis of DAG parallelism. *)
58
58
+120
day11/opam_layer/README.md
+120
day11/opam_layer/README.md
···
1
+
# opam_layer — Opam-flavoured layer types and sidecars
2
+
3
+
Domain-specific extensions on top of [`day11_layer`](../layer/) for
4
+
opam package builds. This is the only place in day11 that knows what
5
+
an "opam package layer" actually is — the generic layer library
6
+
underneath knows nothing about opam.
7
+
8
+
For odoc documentation layers, see the sister library
9
+
[`day11_doc_layer`](../doc_layer/), which is independent of this one
10
+
and depends only on `day11_layer`.
11
+
12
+
## What it adds to the generic library
13
+
14
+
- **Recursive in-memory build types** (`Build.t`, `Tool.t`) used by
15
+
the planner and executor
16
+
- **`build.json` sidecar** (`Build_meta.t`) for opam package build
17
+
layers
18
+
- **Opam switch helpers**: `Installed_files`, `Opam_repo`, `Opamh`
19
+
20
+
## External dependencies
21
+
22
+
- `day11_layer` — generic layer cache
23
+
- `day11_exec` — sudo wrappers
24
+
- `day11_graph` — `Universe.t`
25
+
- `opam-format` — `OpamPackage.t` and switch state
26
+
- `bos`, `fpath`, `rresult`, `yojson` + `ppx_deriving_yojson`
27
+
28
+
## Modules
29
+
30
+
### `Build` — recursive in-memory build node
31
+
32
+
```ocaml
33
+
type t = {
34
+
hash : string;
35
+
pkg : OpamPackage.t;
36
+
deps : t list;
37
+
universe : Day11_graph.Universe.t;
38
+
}
39
+
val dir_name : t -> string
40
+
val dir : os_dir:Fpath.t -> t -> Fpath.t
41
+
```
42
+
43
+
The DAG node used throughout the planner, hash cache, and executor.
44
+
[`day11_build`](../build/) takes these as input.
45
+
46
+
### `Tool`
47
+
48
+
```ocaml
49
+
type t = { hash : string; dir : Fpath.t; builds : Build.t list }
50
+
```
51
+
52
+
An aggregate of one or more `Build.t` layers (e.g. odoc plus its
53
+
deps), used as a fixed input to other build containers — the doc
54
+
pipeline takes a `Tool.t` for each compiler that needs odoc binaries
55
+
mounted.
56
+
57
+
### `Build_meta` — `build.json` sidecar
58
+
59
+
Marks a layer as the result of an opam package build.
60
+
61
+
```ocaml
62
+
type t = {
63
+
package : string;
64
+
deps : string list; (* parallel to layer.json's parent_hashes *)
65
+
installed_libs : string list;
66
+
installed_docs : string list;
67
+
patches : string list;
68
+
}
69
+
70
+
val filename : string (* "build.json" *)
71
+
val save : Fpath.t -> t -> (unit, _) result
72
+
val load : Fpath.t -> (t, _) result
73
+
val exists : Fpath.t -> bool
74
+
val load_tree : os_dir:Fpath.t -> string -> (Build.t, _) result
75
+
```
76
+
77
+
`load_tree` reconstructs a `Build.t` tree from the cache by recursively
78
+
walking parent_hashes in `layer.json` plus the package field in
79
+
`build.json`.
80
+
81
+
### `Installed_files` — opam switch scanner
82
+
83
+
```ocaml
84
+
val scan_libs : layer_dir:Fpath.t -> string list
85
+
val scan_docs : layer_dir:Fpath.t -> string list
86
+
```
87
+
88
+
Walks `layer_dir/fs/home/opam/.opam/default/{lib,doc}/` for
89
+
`.cmi`/`.cmxa`/`META`/`.mld`/etc. Used by `Build_layer` after a
90
+
container exits to populate `Build_meta.installed_libs/installed_docs`.
91
+
92
+
### `Opam_repo` — opam-repository assembly
93
+
94
+
```ocaml
95
+
val create : Fpath.t -> (Fpath.t, _) result
96
+
val populate :
97
+
opam_repo:Fpath.t -> opam_repositories:Fpath.t list ->
98
+
OpamPackage.t list -> (unit, _) result
99
+
```
100
+
101
+
Builds a minimal `opam-repository/` tree containing just the opam
102
+
files needed for a package and its deps.
103
+
104
+
### `Opamh` — opam switch state
105
+
106
+
```ocaml
107
+
val compiler_packages : OpamPackage.Name.t list
108
+
val dump_state : Fpath.t list -> Fpath.t -> (unit, _) result
109
+
```
110
+
111
+
Identifies compiler packages and writes a `switch-state` file
112
+
describing what's installed inside a container.
113
+
114
+
## Why split
115
+
116
+
The generic [`day11_layer`](../layer/) library can be linked without
117
+
pulling in `opam-format` or any opam-specific concepts. This makes it
118
+
suitable for layer-cache use cases unrelated to opam. The opam
119
+
specifics live here. The odoc-specific format lives in
120
+
[`day11_doc_layer`](../doc_layer/).
+10
day11/opam_layer/build.ml
+10
day11/opam_layer/build.ml
+33
day11/opam_layer/build.mli
+33
day11/opam_layer/build.mli
···
1
+
(** In-memory build DAG node for an opam package layer.
2
+
3
+
{!t} is the recursive type used by the planner, executor, and
4
+
cache lookup paths to represent one opam package build. Each node
5
+
carries:
6
+
7
+
- a content-addressed [hash] computed from the base image, the
8
+
transitive dep hashes, and the package's effective opam file
9
+
- the [pkg] being built
10
+
- a [deps] list — the *direct* dependency build nodes (which
11
+
themselves carry their own [deps], so the field forms a DAG)
12
+
- a [universe] identifier so that two builds of the same package
13
+
against different sets of co-installed packages get distinct
14
+
cache entries
15
+
16
+
Use {!dir_name} or {!dir} to derive the on-disk path for a node;
17
+
those wrap {!Day11_layer.Dir} which encodes the
18
+
[build-XXXXXXXXXXXX] convention. *)
19
+
20
+
type t = {
21
+
hash : string;
22
+
pkg : OpamPackage.t;
23
+
deps : t list;
24
+
universe : Day11_graph.Universe.t;
25
+
}
26
+
27
+
val dir_name : t -> string
28
+
(** [dir_name b] returns the layer directory name for [b]
29
+
(e.g. ["build-c9f7404f9f87"]). *)
30
+
31
+
val dir : os_dir:Fpath.t -> t -> Fpath.t
32
+
(** [dir ~os_dir b] returns the absolute layer directory under
33
+
[os_dir]. *)
+62
day11/opam_layer/build_meta.ml
+62
day11/opam_layer/build_meta.ml
···
1
+
type t = {
2
+
package : string;
3
+
deps : string list; [@default []]
4
+
installed_libs : string list; [@default []]
5
+
installed_docs : string list; [@default []]
6
+
patches : string list; [@default []]
7
+
} [@@deriving yojson { strict = false }]
8
+
9
+
let filename = "build.json"
10
+
11
+
let save layer_dir t =
12
+
let path = Fpath.(layer_dir / "build.json") in
13
+
try
14
+
Yojson.Safe.to_file (Fpath.to_string path) (to_yojson t);
15
+
Ok ()
16
+
with exn ->
17
+
Rresult.R.error_msgf "Build_meta.save %a: %s"
18
+
Fpath.pp path (Printexc.to_string exn)
19
+
20
+
let load layer_dir =
21
+
let path = Fpath.(layer_dir / "build.json") in
22
+
try
23
+
match of_yojson (Yojson.Safe.from_file (Fpath.to_string path)) with
24
+
| Ok t -> Ok t
25
+
| Error msg ->
26
+
Rresult.R.error_msgf "Build_meta.load %a: %s" Fpath.pp path msg
27
+
with exn ->
28
+
Rresult.R.error_msgf "Build_meta.load %a: %s"
29
+
Fpath.pp path (Printexc.to_string exn)
30
+
31
+
let exists layer_dir =
32
+
Bos.OS.File.exists Fpath.(layer_dir / "build.json") |> Result.value ~default:false
33
+
34
+
let load_tree ~os_dir hash =
35
+
let cache : (string, Build.t) Hashtbl.t = Hashtbl.create 16 in
36
+
let ( let* ) r f = match r with Ok v -> f v | Error _ as e -> e in
37
+
let rec load_h h =
38
+
match Hashtbl.find_opt cache h with
39
+
| Some b -> Ok b
40
+
| None ->
41
+
let layer_dir = Day11_layer.Dir.path ~os_dir h in
42
+
let* layer_meta =
43
+
Day11_layer.Meta.load Fpath.(layer_dir / "layer.json")
44
+
in
45
+
let* build_meta = load layer_dir in
46
+
let* deps = load_deps layer_meta.parent_hashes in
47
+
let build : Build.t = {
48
+
hash = h;
49
+
pkg = OpamPackage.of_string build_meta.package;
50
+
deps;
51
+
universe = Day11_graph.Universe.dummy;
52
+
} in
53
+
Hashtbl.replace cache h build;
54
+
Ok build
55
+
and load_deps hashes =
56
+
List.fold_left (fun acc h ->
57
+
let* acc = acc in
58
+
let* dep = load_h h in
59
+
Ok (acc @ [ dep ])
60
+
) (Ok []) hashes
61
+
in
62
+
load_h hash
+53
day11/opam_layer/build_meta.mli
+53
day11/opam_layer/build_meta.mli
···
1
+
(** Opam build sidecar: per-layer metadata for opam package builds.
2
+
3
+
Lives next to {!Day11_layer.Meta} as [build.json] in the
4
+
layer directory. The presence of this file marks a layer as the
5
+
output of an opam package build (as opposed to e.g. a doc layer,
6
+
see {!Doc_meta}, or a future layer kind that doesn't yet exist).
7
+
8
+
The opam-specific information is kept here so that
9
+
{!Day11_layer.Meta} can stay generic and reusable across
10
+
layer kinds. *)
11
+
12
+
type t = {
13
+
package : string;
14
+
(** The opam package this layer was built for, as a
15
+
[name.version] string. *)
16
+
deps : string list;
17
+
(** Direct dependency package strings, parallel to
18
+
[parent_hashes] in the generic {!Day11_layer.Meta.t}. *)
19
+
installed_libs : string list;
20
+
(** Files under [/home/opam/.opam/default/lib/] that this build
21
+
installed. Discovered by {!Installed_files.scan_libs} after
22
+
the container exits. *)
23
+
installed_docs : string list;
24
+
(** Files under [/home/opam/.opam/default/doc/] that this build
25
+
installed. Discovered by {!Installed_files.scan_docs}. *)
26
+
patches : string list;
27
+
(** Filenames of patch files applied to this package before
28
+
building, if any. *)
29
+
}
30
+
31
+
val filename : string
32
+
(** ["build.json"] — the on-disk filename relative to the layer
33
+
directory. *)
34
+
35
+
val save : Fpath.t -> t -> (unit, [> Rresult.R.msg ]) result
36
+
(** [save layer_dir t] writes [t] as [layer_dir/build.json]. *)
37
+
38
+
val load : Fpath.t -> (t, [> Rresult.R.msg ]) result
39
+
(** [load layer_dir] reads [layer_dir/build.json] and parses it.
40
+
Returns [Error] if the file is missing or malformed. *)
41
+
42
+
val exists : Fpath.t -> bool
43
+
(** [exists layer_dir] is [true] iff [layer_dir/build.json] exists.
44
+
Use this to identify "this is an opam build layer" without
45
+
needing to parse the contents. *)
46
+
47
+
val load_tree :
48
+
os_dir:Fpath.t -> string ->
49
+
(Build.t, [> Rresult.R.msg ]) result
50
+
(** [load_tree ~os_dir hash] reconstructs a {!Build.t} tree by
51
+
recursively reading layer.json + build.json files starting at
52
+
the layer for [hash]. The [hash] is the full hash (not
53
+
truncated). *)
+5
day11/opam_layer/dune
+5
day11/opam_layer/dune
+4
day11/opam_layer/test/dune
+4
day11/opam_layer/test/dune
+124
day11/opam_layer/test/test_opam_layer.ml
+124
day11/opam_layer/test/test_opam_layer.ml
···
1
+
(* Tests for the day11_opam_layer library. *)
2
+
3
+
open Day11_opam_layer
4
+
open Day11_test_util.Test_util
5
+
6
+
let is_ok msg r = ok_or_fail msg r |> ignore
7
+
8
+
let pkg_list ss = List.map OpamPackage.of_string ss
9
+
10
+
(* ── Build_meta tests ────────────────────────────────────────────── *)
11
+
12
+
let test_build_meta_roundtrip () = with_tmp_dir @@ fun layer_dir ->
13
+
let m : Build_meta.t = {
14
+
package = "yojson.2.2.2";
15
+
deps = [ "dune.3.0"; "cppo.1.6" ];
16
+
installed_libs = [ "yojson/yojson.cmi"; "yojson/META" ];
17
+
installed_docs = [];
18
+
patches = [];
19
+
} in
20
+
Build_meta.save layer_dir m |> is_ok "save";
21
+
Alcotest.(check bool) "exists" true (Build_meta.exists layer_dir);
22
+
let loaded = Build_meta.load layer_dir |> ok_or_fail "load" in
23
+
Alcotest.(check string) "package" "yojson.2.2.2" loaded.package;
24
+
Alcotest.(check (list string)) "deps"
25
+
[ "dune.3.0"; "cppo.1.6" ] loaded.deps;
26
+
Alcotest.(check int) "libs count" 2 (List.length loaded.installed_libs)
27
+
28
+
let test_build_meta_missing () = with_tmp_dir @@ fun layer_dir ->
29
+
Alcotest.(check bool) "exists false" false (Build_meta.exists layer_dir);
30
+
match Build_meta.load layer_dir with
31
+
| Ok _ -> Alcotest.fail "should not load missing"
32
+
| Error _ -> ()
33
+
34
+
(* ── Installed_files tests ───────────────────────────────────────── *)
35
+
36
+
let test_scan_libs () = with_tmp_dir @@ fun dir ->
37
+
let lib_dir = Fpath.(dir / "fs" / "home" / "opam" / ".opam" / "default" / "lib" / "yojson") in
38
+
mkdir lib_dir;
39
+
write_file Fpath.(lib_dir / "yojson.cmi") "";
40
+
write_file Fpath.(lib_dir / "yojson.cmxa") "";
41
+
write_file Fpath.(lib_dir / "META") "";
42
+
write_file Fpath.(lib_dir / "README.md") "";
43
+
let files = Installed_files.scan_libs ~layer_dir:dir in
44
+
Alcotest.(check bool) "has cmi"
45
+
true (List.mem "yojson/yojson.cmi" files);
46
+
Alcotest.(check bool) "has META"
47
+
true (List.mem "yojson/META" files);
48
+
Alcotest.(check bool) "no README"
49
+
false (List.mem "yojson/README.md" files)
50
+
51
+
let test_scan_docs () = with_tmp_dir @@ fun dir ->
52
+
let doc_dir = Fpath.(dir / "fs" / "home" / "opam" / ".opam" / "default" / "doc" / "yojson") in
53
+
mkdir doc_dir;
54
+
write_file Fpath.(doc_dir / "index.mld") "";
55
+
write_file Fpath.(doc_dir / "odoc-config.sexp") "";
56
+
write_file Fpath.(doc_dir / "README") "";
57
+
let files = Installed_files.scan_docs ~layer_dir:dir in
58
+
Alcotest.(check bool) "has mld"
59
+
true (List.mem "yojson/index.mld" files);
60
+
Alcotest.(check bool) "has sexp"
61
+
true (List.mem "yojson/odoc-config.sexp" files);
62
+
Alcotest.(check bool) "no README"
63
+
false (List.mem "yojson/README" files)
64
+
65
+
let test_scan_empty_layer () = with_tmp_dir @@ fun dir ->
66
+
let files = Installed_files.scan_libs ~layer_dir:dir in
67
+
Alcotest.(check (list string)) "empty" [] files
68
+
69
+
(* ── Opam_repo tests ─────────────────────────────────────────────── *)
70
+
71
+
let test_opam_repo_create () = with_tmp_dir @@ fun dir ->
72
+
let repo_dir = Opam_repo.create dir |> ok_or_fail "create" in
73
+
Alcotest.(check bool) "repo file exists"
74
+
true (Bos.OS.File.exists Fpath.(repo_dir / "repo") |> Result.get_ok)
75
+
76
+
let test_opam_repo_populate () = with_tmp_dir @@ fun dir ->
77
+
let src_repo = Fpath.(dir / "opam-repo") in
78
+
let pkg_dir = Fpath.(src_repo / "packages" / "yojson" / "yojson.2.2.2") in
79
+
mkdir pkg_dir;
80
+
write_file Fpath.(pkg_dir / "opam") {|opam-version: "2.0"|};
81
+
let tgt_repo = Opam_repo.create dir |> ok_or_fail "create" in
82
+
Opam_repo.populate ~opam_repo:tgt_repo
83
+
~opam_repositories:[ src_repo ]
84
+
(pkg_list [ "yojson.2.2.2" ])
85
+
|> is_ok "populate";
86
+
let copied = Fpath.(tgt_repo / "packages" / "yojson" / "yojson.2.2.2" / "opam") in
87
+
Alcotest.(check bool) "opam file copied"
88
+
true (Bos.OS.File.exists copied |> Result.get_ok)
89
+
90
+
(* ── Opamh tests ─────────────────────────────────────────────────── *)
91
+
92
+
let test_compiler_packages () =
93
+
let names = List.map OpamPackage.Name.to_string Opamh.compiler_packages in
94
+
Alcotest.(check bool) "has ocaml"
95
+
true (List.mem "ocaml" names);
96
+
Alcotest.(check bool) "has ocaml-base-compiler"
97
+
true (List.mem "ocaml-base-compiler" names)
98
+
99
+
(* ── Test registration ───────────────────────────────────────────── *)
100
+
101
+
let () =
102
+
Alcotest.run "day11_opam_layer"
103
+
[
104
+
( "Build_meta",
105
+
[
106
+
Alcotest.test_case "roundtrip" `Quick test_build_meta_roundtrip;
107
+
Alcotest.test_case "missing" `Quick test_build_meta_missing;
108
+
] );
109
+
( "Installed_files",
110
+
[
111
+
Alcotest.test_case "scan_libs" `Quick test_scan_libs;
112
+
Alcotest.test_case "scan_docs" `Quick test_scan_docs;
113
+
Alcotest.test_case "empty layer" `Quick test_scan_empty_layer;
114
+
] );
115
+
( "Opam_repo",
116
+
[
117
+
Alcotest.test_case "create" `Quick test_opam_repo_create;
118
+
Alcotest.test_case "populate" `Quick test_opam_repo_populate;
119
+
] );
120
+
( "Opamh",
121
+
[
122
+
Alcotest.test_case "compiler_packages" `Quick test_compiler_packages;
123
+
] );
124
+
]
+5
day11/opam_layer/tool.ml
+5
day11/opam_layer/tool.ml
+9
day11/opam_layer/tool.mli
+9
day11/opam_layer/tool.mli