forked from
anil.recoil.org/monopam-myspace
My aggregated monorepo of OCaml code, automaintained
Fix documentation gaps across day11
- layer.mld: add Layer module, update description for new core type
- batch.mld: add Profile and Snapshot modules
- doc.mld: add Doc_build module
- generate.mli: add doc comment for run function
- patches.mli: new interface file for Patches module
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
+1979
-869
+87
-1
batch/profile.ml
+87
-1
batch/profile.ml
···
19
19
driver_compiler : string;
20
20
extra_pins : string list;
21
21
patches_dir : string option;
22
+
base_image_digest : string option;
23
+
base_image_updated : string option;
24
+
(* ISO-8601 timestamp of when base_image_digest was resolved *)
22
25
}
23
26
24
27
let target_mode_to_json = function
···
59
62
("driver_compiler", `String t.driver_compiler);
60
63
("extra_pins", `List (List.map (fun s -> `String s) t.extra_pins));
61
64
("patches_dir", opt_to_json t.patches_dir);
65
+
("base_image_digest", opt_to_json t.base_image_digest);
66
+
("base_image_updated", opt_to_json t.base_image_updated);
62
67
]
63
68
64
69
let of_json json =
···
91
96
with _ -> "ocaml-base-compiler.5.4.1");
92
97
extra_pins = (try str_list "extra_pins" with _ -> []);
93
98
patches_dir = str_opt "patches_dir";
99
+
base_image_digest = str_opt "base_image_digest";
100
+
base_image_updated = str_opt "base_image_updated";
94
101
}
95
102
with exn ->
96
103
Rresult.R.error_msgf "Profile.of_json: %s" (Printexc.to_string exn)
···
131
138
let os_dir_name t =
132
139
Printf.sprintf "%s-%s-%s" t.os_distribution t.os_version t.arch
133
140
141
+
let base_image_tag t =
142
+
Printf.sprintf "%s:%s" t.os_distribution t.os_version
143
+
134
144
let default_dir () =
135
145
let home = try Sys.getenv "HOME" with Not_found -> "/tmp" in
136
146
Fpath.v (Filename.concat home ".day11")
137
147
148
+
let now_iso8601 () =
149
+
let t = Unix.gettimeofday () in
150
+
let tm = Unix.gmtime t in
151
+
Printf.sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ"
152
+
(tm.tm_year + 1900) (tm.tm_mon + 1) tm.tm_mday
153
+
tm.tm_hour tm.tm_min tm.tm_sec
154
+
155
+
(** Resolve the base image digest from the Docker registry.
156
+
This calls `docker manifest inspect` which queries the registry
157
+
without pulling. Can be slow (~10-15s). *)
158
+
let resolve_base_digest t =
159
+
let tag = base_image_tag t in
160
+
let cmd = Printf.sprintf
161
+
"docker manifest inspect %s 2>/dev/null" (Filename.quote tag) in
162
+
let ic = Unix.open_process_in cmd in
163
+
let buf = Buffer.create 4096 in
164
+
(try while true do Buffer.add_char buf (input_char ic) done
165
+
with End_of_file -> ());
166
+
ignore (Unix.close_process_in ic);
167
+
let json_str = Buffer.contents buf in
168
+
try
169
+
let json = Yojson.Safe.from_string json_str in
170
+
let open Yojson.Safe.Util in
171
+
let manifests = json |> member "manifests" |> to_list in
172
+
let arch = t.arch in
173
+
let docker_arch = match arch with
174
+
| "x86_64" | "amd64" -> "amd64"
175
+
| "aarch64" -> "arm64"
176
+
| a -> a
177
+
in
178
+
List.find_map (fun m ->
179
+
let plat = m |> member "platform" in
180
+
let m_arch = plat |> member "architecture" |> to_string in
181
+
let m_os = plat |> member "os" |> to_string in
182
+
if m_arch = docker_arch && m_os = "linux" then
183
+
Some (m |> member "digest" |> to_string)
184
+
else None
185
+
) manifests
186
+
with _ -> None
187
+
188
+
(** Check if the base image digest is older than [max_age_days]. *)
189
+
let base_image_stale ?(max_age_days = 30) t =
190
+
match t.base_image_updated with
191
+
| None -> true (* no timestamp = stale *)
192
+
| Some ts ->
193
+
(* Parse ISO-8601 timestamp *)
194
+
try
195
+
Scanf.sscanf ts "%4d-%2d-%2dT%2d:%2d:%2dZ"
196
+
(fun year mon day hour min sec ->
197
+
let tm = { Unix.tm_sec = sec; tm_min = min; tm_hour = hour;
198
+
tm_mday = day; tm_mon = mon - 1; tm_year = year - 1900;
199
+
tm_wday = 0; tm_yday = 0; tm_isdst = false } in
200
+
let then_t, _ = Unix.mktime tm in
201
+
let age_days = (Unix.gettimeofday () -. then_t) /. 86400. in
202
+
age_days > float max_age_days)
203
+
with _ -> true
204
+
205
+
(** Update the profile's base image digest by querying the registry.
206
+
Returns the updated profile (caller must save it). *)
207
+
let refresh_base_digest t =
208
+
match resolve_base_digest t with
209
+
| Some digest ->
210
+
Ok { t with
211
+
base_image_digest = Some digest;
212
+
base_image_updated = Some (now_iso8601 ()) }
213
+
| None ->
214
+
Error (`Msg (Printf.sprintf
215
+
"Failed to resolve digest for %s" (base_image_tag t)))
216
+
138
217
let pp fmt t =
139
218
Fmt.pf fmt "@[<v>\
140
219
Profile: %s@,\
···
145
224
Targets: %s@,\
146
225
Docs: %b@,\
147
226
Platform: %s-%s-%s@,\
227
+
Base image: %s%s@,\
148
228
Driver compiler: %s\
149
229
@]"
150
230
t.name
···
158
238
| Packages pkgs -> String.concat ", " pkgs)
159
239
t.with_doc
160
240
t.os_distribution t.os_version t.arch
161
-
t.driver_compiler
241
+
(match t.base_image_digest with
242
+
| Some d -> String.sub d 0 (min 20 (String.length d)) ^ "..."
243
+
| None -> "(not pinned)")
244
+
(match t.base_image_updated with
245
+
| Some ts -> Printf.sprintf " (%s)" ts
246
+
| None -> "")
247
+
(if t.driver_compiler = "" then "(auto)" else t.driver_compiler)
+17
batch/profile.mli
+17
batch/profile.mli
···
26
26
driver_compiler : string;
27
27
extra_pins : string list;
28
28
patches_dir : string option;
29
+
base_image_digest : string option;
30
+
base_image_updated : string option;
29
31
}
30
32
31
33
val save : dir:Fpath.t -> t -> (unit, [> Rresult.R.msg ]) result
···
53
55
54
56
val default_dir : unit -> Fpath.t
55
57
(** [~/.day11] *)
58
+
59
+
val base_image_tag : t -> string
60
+
(** E.g. ["debian:bookworm"]. *)
61
+
62
+
val resolve_base_digest : t -> string option
63
+
(** Query the Docker registry for the current image digest.
64
+
Calls [docker manifest inspect] — can take 10-15 seconds. *)
65
+
66
+
val refresh_base_digest : t -> (t, [> Rresult.R.msg ]) result
67
+
(** Resolve the digest and return an updated profile.
68
+
Caller must save the profile. *)
69
+
70
+
val base_image_stale : ?max_age_days:int -> t -> bool
71
+
(** Returns [true] if the base image digest is older than
72
+
[max_age_days] (default 30), or if no digest is recorded. *)
+8
-7
batch/rerun.ml
+8
-7
batch/rerun.ml
···
1
1
module Build = Day11_opam_layer.Build
2
2
module Tool = Day11_opam_layer.Tool
3
+
module Layer = Day11_layer.Layer
3
4
type build = Build.t
4
5
5
6
let load_exit_status layer_json =
···
18
19
~uid:meta.uid ~gid:meta.gid ()
19
20
20
21
let rerun env ~os_dir ~cache_dir node =
21
-
let layer_dir = Build.dir ~os_dir node in
22
-
let layer_json = Fpath.(layer_dir / "layer.json") in
23
-
match Day11_layer.Meta.load layer_json with
22
+
let layer = Build.layer ~os_dir node in
23
+
let layer_dir = Layer.dir layer in
24
+
match Day11_layer.Meta.load (Layer.meta_path layer) with
24
25
| Error (`Msg e) ->
25
26
Day11_opam_build.Types.Failure e
26
27
| Ok { exit_status = 0; _ } ->
···
40
41
let cascade env ~os_dir ~cache_dir nodes =
41
42
let rerun_count = ref 0 in
42
43
List.iter (fun (node : build) ->
43
-
let layer_json = Fpath.(Build.dir ~os_dir node / "layer.json") in
44
-
match load_exit_status layer_json with
44
+
let layer = Build.layer ~os_dir node in
45
+
match load_exit_status (Layer.meta_path layer) with
45
46
| Some (-1) ->
46
47
let all_deps_ok = List.for_all (fun (dep : build) ->
47
-
let dep_json = Fpath.(Build.dir ~os_dir dep / "layer.json") in
48
-
load_exit_status dep_json = Some 0
48
+
let dep_layer = Build.layer ~os_dir dep in
49
+
load_exit_status (Layer.meta_path dep_layer) = Some 0
49
50
) node.deps in
50
51
if all_deps_ok then begin
51
52
ignore (rerun env ~os_dir ~cache_dir node);
+5
-5
batch/summary.ml
+5
-5
batch/summary.ml
···
77
77
~pkg_str:(OpamPackage.to_string d.pkg) entry
78
78
) results.docs
79
79
80
-
let generate_status ~os_dir ~packages_dir ~run_id =
81
-
let previous = Day11_lib.Status_index.read ~dir:os_dir in
80
+
let generate_status ~snapshot_dir ~packages_dir ~run_id =
81
+
let previous = Day11_lib.Status_index.read ~dir:snapshot_dir in
82
82
let status =
83
83
Day11_lib.Status_index.generate ~packages_dir ~run_id ~previous
84
84
in
85
-
Day11_lib.Status_index.write ~dir:os_dir status
85
+
Day11_lib.Status_index.write ~dir:snapshot_dir status
86
86
87
-
let finish ~os_dir ~packages_dir ~run_info ~compiler results =
87
+
let finish ~snapshot_dir ~packages_dir ~run_info ~compiler results =
88
88
let run_id = Day11_lib.Run_log.get_id run_info in
89
89
record_history ~packages_dir ~run_id ~compiler results;
90
-
generate_status ~os_dir ~packages_dir ~run_id;
90
+
generate_status ~snapshot_dir ~packages_dir ~run_id;
91
91
let builds_ok =
92
92
List.length (List.filter (fun (b : build_outcome) -> b.success) results.builds)
93
93
in
+3
-3
batch/summary.mli
+3
-3
batch/summary.mli
···
34
34
(** Write history entries for every build and doc outcome. *)
35
35
36
36
val generate_status :
37
-
os_dir:Fpath.t ->
37
+
snapshot_dir:Fpath.t ->
38
38
packages_dir:Fpath.t ->
39
39
run_id:string ->
40
40
unit
···
42
42
from the previous snapshot. *)
43
43
44
44
val finish :
45
-
os_dir:Fpath.t ->
45
+
snapshot_dir:Fpath.t ->
46
46
packages_dir:Fpath.t ->
47
47
run_info:Day11_lib.Run_log.t ->
48
48
compiler:string ->
49
49
results ->
50
50
Day11_lib.Run_log.summary
51
-
(** [finish ~os_dir ~packages_dir ~run_info ~compiler results]
51
+
(** [finish ~snapshot_dir ~packages_dir ~run_info ~compiler results]
52
52
records history, generates status.json, finishes the run log,
53
53
and prints a summary to stdout. Returns the run summary. *)
+3
-3
batch/test/test_batch_integration.ml
+3
-3
batch/test/test_batch_integration.ml
···
135
135
Printf.printf " History entries: %d packages with history\n%!"
136
136
(List.length results.builds);
137
137
(* Generate status *)
138
-
Summary.generate_status ~os_dir ~packages_dir ~run_id:"test-int";
138
+
Summary.generate_status ~snapshot_dir:os_dir ~packages_dir ~run_id:"test-int";
139
139
let status = Day11_lib.Status_index.read
140
140
~dir:os_dir in
141
141
Alcotest.(check bool) "status.json written" true (status <> None)
···
171
171
let benv = Types.make_build_env ~base ~os_dir ~uid:1000 ~gid:1000 () in
172
172
Types.ensure_dirs benv;
173
173
Dag_executor.execute env ~np:2
174
-
~on_complete:(fun ~total ~completed ~failed node success ->
174
+
~on_complete:(fun ~stats node success ->
175
175
Printf.printf " [%d/%d, %d failed] %s: %s\n%!"
176
-
completed total failed
176
+
stats.Day11_opam_build.Dag_executor.completed stats.total stats.failed
177
177
(OpamPackage.to_string node.pkg)
178
178
(if success then "OK" else "FAIL");
179
179
if success then
+9
-9
batch/test/test_cmdliner_all.ml
+9
-9
batch/test/test_cmdliner_all.ml
···
81
81
let cascaded = Atomic.make 0 in
82
82
let t0 = Unix.gettimeofday () in
83
83
Dag_executor.execute env ~np:4
84
-
~on_complete:(fun ~total ~completed ~failed:f node success ->
85
-
if success then begin
86
-
Atomic.incr succeeded;
87
-
Printf.printf " [%d/%d, %d failed] %s: OK\n%!"
88
-
completed total f (OpamPackage.to_string node.pkg)
89
-
end else begin
84
+
~on_complete:(fun ~stats node success ->
85
+
if success then
86
+
Atomic.incr succeeded
87
+
else
90
88
Atomic.incr failed;
91
-
Printf.printf " [%d/%d, %d failed] %s: FAIL\n%!"
92
-
completed total f (OpamPackage.to_string node.pkg)
93
-
end)
89
+
if stats.Day11_opam_build.Dag_executor.completed mod 10 = 0 then
90
+
Printf.printf " [%d/%d] %s: %s\n%!"
91
+
stats.completed stats.total
92
+
(OpamPackage.to_string node.pkg)
93
+
(if success then "OK" else "FAIL"))
94
94
~on_cascade:(fun ~failed:_ ~failed_dep:_ ->
95
95
Atomic.incr cascaded)
96
96
nodes
+30
-26
bin/cmd_batch.ml
+30
-26
bin/cmd_batch.ml
···
3
3
open Cmdliner
4
4
module Build = Day11_opam_layer.Build
5
5
module Tool = Day11_opam_layer.Tool
6
+
module Layer = Day11_layer.Layer
6
7
type build = Build.t
7
8
type tool = Tool.t
8
9
···
35
36
| Ok x -> x | Error (`Msg e) -> Printf.eprintf "Error: %s\n" e; exit 1
36
37
in
37
38
Common.ensure_paths paths;
39
+
(* Warn if base image digest is stale or not pinned *)
40
+
if Day11_batch.Profile.base_image_stale profile then
41
+
Printf.printf "WARNING: Base image digest is %s. Run 'day11 profile refresh-base --name %s' to update.\n%!"
42
+
(match profile.base_image_digest with
43
+
| None -> "not pinned"
44
+
| Some _ -> "more than 30 days old")
45
+
profile_name;
38
46
let cache_dir = paths.cache_dir in
39
47
let os_dir = paths.os_dir in
40
48
let ocaml_version = Common.parse_ocaml_version profile.compiler in
41
-
let driver_compiler = OpamPackage.of_string profile.driver_compiler in
49
+
let driver_compiler = if profile.driver_compiler = ""
50
+
then None
51
+
else Some (OpamPackage.of_string profile.driver_compiler) in
42
52
let opam_repositories = profile.opam_repositories in
43
53
let with_doc = profile.with_doc in
44
54
let os_distribution = profile.os_distribution in
···
199
209
let base_opt = Day11_opam_build.Base.load_cached ~cache_dir
200
210
~os_distribution ~os_version in
201
211
let base_hash = Day11_opam_build.Base.build_hash
202
-
~os_distribution ~os_version ~arch in
212
+
~os_distribution ~os_version ~arch ?digest:profile.base_image_digest () in
203
213
(* Build DAG — no Eio needed *)
204
214
let cache = Day11_opam_build.Hash_cache.create ~find_opam ?patches () in
205
215
let nodes = Day11_opam_build.Dag.build_dag cache
···
210
220
let root_deleted = ref 0 in
211
221
let cascade_deleted = ref 0 in
212
222
List.iter (fun (node : Day11_opam_layer.Build.t) ->
213
-
let dir = Day11_opam_layer.Build.dir ~os_dir node in
214
-
let layer_json = Fpath.(dir / "layer.json") in
215
-
if Bos.OS.File.exists layer_json |> Result.get_ok then
216
-
match Day11_layer.Meta.load layer_json with
223
+
let layer = Build.layer ~os_dir node in
224
+
if Layer.exists layer then
225
+
match Day11_layer.Meta.load (Layer.meta_path layer) with
217
226
| Ok { exit_status; failed_dep; _ } when exit_status <> 0 ->
218
-
ignore (Bos.OS.Path.delete ~recurse:true dir);
227
+
ignore (Bos.OS.Path.delete ~recurse:true (Layer.dir layer));
219
228
if failed_dep = None then incr root_deleted
220
229
else incr cascade_deleted
221
230
| _ -> ()
···
226
235
end;
227
236
(* Check which layers already exist *)
228
237
let n_cached = List.length (List.filter (fun (node : Day11_opam_layer.Build.t) ->
229
-
let dir = Day11_opam_layer.Build.dir ~os_dir node in
230
-
Bos.OS.File.exists Fpath.(dir / "layer.json") |> Result.get_ok
238
+
Layer.exists (Build.layer ~os_dir node)
231
239
) nodes) in
232
240
let n_need_build = List.length nodes - n_cached in
233
241
Printf.printf "Layers: %d cached, %d need building\n%!" n_cached n_need_build;
···
237
245
if n_need_build > 0 then begin
238
246
Printf.printf "\nLayers to build:\n";
239
247
List.iter (fun (node : Day11_opam_layer.Build.t) ->
240
-
let dir = Day11_opam_layer.Build.dir ~os_dir node in
241
-
if not (Bos.OS.File.exists Fpath.(dir / "layer.json")
242
-
|> Result.get_ok) then
248
+
if not (Layer.exists (Build.layer ~os_dir node)) then
243
249
Printf.printf " %s (%d deps)\n"
244
250
(OpamPackage.to_string node.pkg) (List.length node.deps)
245
251
) nodes
···
269
275
(match Day11_opam_build.Base.build env ~cache_dir
270
276
~os_distribution ~os_version ~arch
271
277
~opam_repositories:(List.map Fpath.v opam_repositories) ~uid ~gid
272
-
() with
278
+
?digest:profile.base_image_digest () with
273
279
| Ok base -> base
274
280
| Error (`Msg e) ->
275
281
Printf.eprintf "Base image build failed: %s\n%!" e;
···
377
383
Day11_doc.Generate.build_tools_and_run env benv ~np ~os_dir
378
384
~packages:git_packages ~repos:repos_with_shas ~opam_env
379
385
~mounts:base_mounts
380
-
~driver_compiler ~odoc_repo ~build_one
386
+
?driver_compiler ~odoc_repo ~build_one
381
387
~opam_repositories ~cache ~run_log
382
-
~nodes ~solutions ~blessing_maps
388
+
~nodes ~solutions ~blessing_maps ()
383
389
end
384
390
else begin
385
391
(* Build only — no docs *)
386
392
let is_cached node =
387
-
let layer_dir = Day11_opam_layer.Build.dir ~os_dir node in
388
-
let layer_json = Fpath.(layer_dir / "layer.json") in
389
-
if not (Bos.OS.File.exists layer_json |> Result.get_ok) then
393
+
let layer = Build.layer ~os_dir node in
394
+
if not (Layer.exists layer) then
390
395
Day11_opam_build.Dag_executor.Not_cached
391
396
else begin
392
-
Day11_layer.Last_used.touch layer_dir;
393
-
match Day11_layer.Meta.load layer_json with
397
+
Day11_layer.Last_used.touch (Layer.dir layer);
398
+
match Day11_layer.Meta.load (Layer.meta_path layer) with
394
399
| Ok meta ->
395
400
let success = meta.exit_status = 0 in
396
401
record_build_outcome node success;
···
427
432
~on_cascade:(fun ~failed ~failed_dep ->
428
433
Hashtbl.replace cascaded_set failed.hash ();
429
434
(* Write a skeleton layer.json so re-runs skip this node *)
430
-
let layer_dir = Day11_opam_layer.Build.dir ~os_dir failed in
431
-
ignore (Bos.OS.Dir.create ~path:true layer_dir);
432
-
let layer_json = Fpath.(layer_dir / "layer.json") in
433
-
if not (Bos.OS.File.exists layer_json |> Result.get_ok) then begin
435
+
let layer = Build.layer ~os_dir failed in
436
+
ignore (Bos.OS.Dir.create ~path:true (Layer.dir layer));
437
+
if not (Layer.exists layer) then begin
434
438
let meta : Day11_layer.Meta.t = {
435
439
exit_status = 1;
436
440
parent_hashes = [];
···
441
445
created_at = "";
442
446
failed_dep = Some (Day11_opam_layer.Build.dir_name failed_dep);
443
447
} in
444
-
ignore (Day11_layer.Meta.save layer_json meta)
448
+
ignore (Day11_layer.Meta.save (Layer.meta_path layer) meta)
445
449
end;
446
450
(* Create package symlink so the failure is discoverable *)
447
451
let pkg_str = OpamPackage.to_string failed.pkg in
···
476
480
docs = [];
477
481
targets;
478
482
} in
479
-
ignore (Day11_batch.Summary.finish ~os_dir ~packages_dir
483
+
ignore (Day11_batch.Summary.finish ~snapshot_dir ~packages_dir
480
484
~run_info:run_log ~compiler results);
481
485
0
482
486
end
+23
-22
bin/cmd_build.ml
+23
-22
bin/cmd_build.ml
···
1
1
(** build command: solve and build a single package within a profile *)
2
2
3
3
open Cmdliner
4
+
module Build = Day11_opam_layer.Build
5
+
module Layer = Day11_layer.Layer
4
6
5
7
let run profile_name profile_dir np target_str doc_output rebuild_failed =
6
8
let profile, paths = match Common.load_profile ~profile_dir ~name:profile_name with
···
46
48
let build_solutions = [ (target, solution) ] in
47
49
let base_hash = Day11_opam_build.Base.build_hash
48
50
~os_distribution:profile.os_distribution
49
-
~os_version:profile.os_version ~arch:profile.arch in
51
+
~os_version:profile.os_version ~arch:profile.arch
52
+
?digest:profile.base_image_digest () in
50
53
let nodes = Day11_opam_build.Dag.build_dag cache
51
54
~base_hash build_solutions in
52
55
Printf.printf "DAG: %d nodes\n%!" (List.length nodes);
···
54
57
if rebuild_failed then begin
55
58
let deleted = ref 0 in
56
59
List.iter (fun (node : Day11_opam_layer.Build.t) ->
57
-
let dir = Day11_opam_layer.Build.dir ~os_dir node in
58
-
let layer_json = Fpath.(dir / "layer.json") in
59
-
if Bos.OS.File.exists layer_json |> Result.get_ok then
60
-
match Day11_layer.Meta.load layer_json with
60
+
let layer = Build.layer ~os_dir node in
61
+
if Layer.exists layer then
62
+
match Day11_layer.Meta.load (Layer.meta_path layer) with
61
63
| Ok { exit_status; _ } when exit_status <> 0 ->
62
-
ignore (Bos.OS.Path.delete ~recurse:true dir);
64
+
ignore (Bos.OS.Path.delete ~recurse:true (Layer.dir layer));
63
65
incr deleted
64
66
| _ -> ()
65
67
) nodes;
···
67
69
Printf.printf "Deleted %d failed layers for rebuild\n%!" !deleted
68
70
end;
69
71
let n_cached = List.length (List.filter (fun (node : Day11_opam_layer.Build.t) ->
70
-
Bos.OS.File.exists Fpath.(Day11_opam_layer.Build.dir ~os_dir node / "layer.json")
71
-
|> Result.get_ok
72
+
Layer.exists (Build.layer ~os_dir node)
72
73
) nodes) in
73
74
Printf.printf "Layers: %d cached, %d to build\n%!" n_cached
74
75
(List.length nodes - n_cached);
···
96
97
~os_distribution:profile.os_distribution
97
98
~os_version:profile.os_version ~arch:profile.arch
98
99
~opam_repositories:(List.map Fpath.v opam_repositories)
99
-
~uid ~gid () with
100
+
~uid ~gid ?digest:profile.base_image_digest () with
100
101
| Ok base -> base
101
102
| Error (`Msg e) ->
102
103
Printf.eprintf "Base image build failed: %s\n%!" e; exit 1)
···
132
133
let open Day11_opam_build.Dag_executor in
133
134
execute env ~np
134
135
~is_cached:(fun node ->
135
-
let layer_dir = Day11_opam_layer.Build.dir ~os_dir node in
136
-
let layer_json = Fpath.(layer_dir / "layer.json") in
137
-
if not (Bos.OS.File.exists layer_json |> Result.get_ok) then
136
+
let layer = Build.layer ~os_dir node in
137
+
if not (Layer.exists layer) then
138
138
Not_cached
139
139
else
140
-
match Day11_layer.Meta.load layer_json with
140
+
match Day11_layer.Meta.load (Layer.meta_path layer) with
141
141
| Ok meta when meta.exit_status = 0 ->
142
-
Day11_layer.Last_used.touch layer_dir;
142
+
Day11_layer.Last_used.touch (Layer.dir layer);
143
143
Cached_ok
144
144
| _ -> Cached_fail)
145
145
~on_complete:(fun ~stats node success ->
···
154
154
(OpamPackage.to_string node.pkg)
155
155
(if success then "OK" else "FAIL"))
156
156
~on_cascade:(fun ~failed ~failed_dep ->
157
-
let layer_dir = Day11_opam_layer.Build.dir ~os_dir failed in
158
-
ignore (Bos.OS.Dir.create ~path:true layer_dir);
159
-
let layer_json = Fpath.(layer_dir / "layer.json") in
160
-
if not (Bos.OS.File.exists layer_json |> Result.get_ok) then begin
157
+
let layer = Build.layer ~os_dir failed in
158
+
ignore (Bos.OS.Dir.create ~path:true (Layer.dir layer));
159
+
if not (Layer.exists layer) then begin
161
160
let meta : Day11_layer.Meta.t = {
162
161
exit_status = 1; parent_hashes = [];
163
162
uid = benv.uid; gid = benv.gid;
···
167
166
created_at = "";
168
167
failed_dep = Some (Day11_opam_layer.Build.dir_name failed_dep);
169
168
} in
170
-
ignore (Day11_layer.Meta.save layer_json meta)
169
+
ignore (Day11_layer.Meta.save (Layer.meta_path layer) meta)
171
170
end)
172
171
nodes
173
172
(fun node ->
···
182
181
Printf.printf "\nGenerating docs to %s...\n%!" output_dir;
183
182
let output = Fpath.v output_dir in
184
183
ignore (Bos.OS.Dir.create ~path:true output);
185
-
let driver_compiler = OpamPackage.of_string profile.driver_compiler in
184
+
let driver_compiler = if profile.driver_compiler = ""
185
+
then None
186
+
else Some (OpamPackage.of_string profile.driver_compiler) in
186
187
let odoc_repo = profile.odoc_repo in
187
188
let solutions = [ (target, solve_result) ] in
188
189
let blessing_maps =
···
193
194
~os_dir
194
195
~packages:git_packages ~repos:repos_with_shas
195
196
~opam_env:_opam_env ~mounts:base_mounts
196
-
~driver_compiler ~odoc_repo
197
+
?driver_compiler ~odoc_repo
197
198
~build_one:(fun node ->
198
199
match Day11_opam_build.Build_layer.build env benv ?patches
199
200
~mounts:base_mounts node () with
200
201
| Day11_opam_build.Types.Success _ -> true
201
202
| _ -> false)
202
203
~opam_repositories ~cache ~run_log
203
-
~nodes ~solutions ~blessing_maps;
204
+
~nodes ~solutions ~blessing_maps ();
204
205
(* Copy HTML for packages in this solution to the output dir *)
205
206
let html_root = Fpath.(os_dir / "html" / "p") in
206
207
let n_copied = ref 0 in
+3
-1
bin/cmd_debug.ml
+3
-1
bin/cmd_debug.ml
···
14
14
| Ok n -> n
15
15
| Error _ ->
16
16
(* Try as package name -- look up from history *)
17
-
let packages_dir = Fpath.(os_dir / "packages") in
17
+
let packages_dir = match Common.latest_snapshot_dir paths with
18
+
| Some sd -> Fpath.(sd / "packages")
19
+
| None -> Fpath.(os_dir / "packages") in
18
20
let entries = Day11_lib.History.read ~packages_dir ~pkg_str:target in
19
21
let failure = List.find_opt (fun (e : Day11_lib.History.entry) ->
20
22
e.status = "failure" && e.build_hash <> "none"
+163
bin/cmd_diff.ml
+163
bin/cmd_diff.ml
···
1
+
(** diff command: compare two snapshots within a profile *)
2
+
3
+
open Cmdliner
4
+
5
+
(* Load all solutions from a snapshot dir, returning (pkg, solve_result) list *)
6
+
let load_solutions snap_dir =
7
+
let sol_dir = Day11_batch.Snapshot.solutions_dir snap_dir in
8
+
match Bos.OS.Dir.contents sol_dir with
9
+
| Error _ -> []
10
+
| Ok files ->
11
+
List.filter_map (fun path ->
12
+
if not (Fpath.has_ext ".json" path) then None
13
+
else if Fpath.basename path = "repos.json" then None
14
+
else
15
+
match Day11_batch.Incremental_solver.load path with
16
+
| Ok (Day11_batch.Incremental_solver.Cached_solution { package; result }) ->
17
+
Some (package, Some result)
18
+
| Ok (Day11_batch.Incremental_solver.Cached_failure { package; _ }) ->
19
+
Some (package, None)
20
+
| Error _ -> None
21
+
) files
22
+
23
+
(* Extract package -> version map from solutions *)
24
+
let version_map solutions =
25
+
List.fold_left (fun acc (pkg, result) ->
26
+
let name = OpamPackage.Name.to_string (OpamPackage.name pkg) in
27
+
let ver = OpamPackage.Version.to_string (OpamPackage.version pkg) in
28
+
let solved = result <> None in
29
+
let deps = match result with
30
+
| Some r -> OpamPackage.Map.cardinal r.Day11_solution.Solve_result.build_deps
31
+
| None -> 0
32
+
in
33
+
(name, (ver, solved, deps)) :: acc
34
+
) [] solutions
35
+
36
+
let run profile_name profile_dir snap1_key snap2_key =
37
+
match Common.load_profile ~profile_dir ~name:profile_name with
38
+
| Error (`Msg e) -> Printf.eprintf "Error: %s\n%!" e; 1
39
+
| Ok (_profile, paths) ->
40
+
let all_snaps = Common.snapshot_dirs_by_recency paths in
41
+
if List.length all_snaps < 2 && snap1_key = None then begin
42
+
Printf.printf "Need at least 2 snapshots to diff (have %d)\n%!"
43
+
(List.length all_snaps);
44
+
1
45
+
end else
46
+
(* Resolve snapshot dirs *)
47
+
let find_snap key =
48
+
List.find_opt (fun p ->
49
+
String.equal (Fpath.basename p) key
50
+
) all_snaps
51
+
in
52
+
let snap1_dir, snap2_dir = match snap1_key, snap2_key with
53
+
| Some k1, Some k2 ->
54
+
(match find_snap k1, find_snap k2 with
55
+
| Some d1, Some d2 -> (d1, d2)
56
+
| None, _ -> Printf.eprintf "Snapshot %s not found\n" k1; exit 1
57
+
| _, None -> Printf.eprintf "Snapshot %s not found\n" k2; exit 1)
58
+
| _ ->
59
+
(* Default: compare two most recent *)
60
+
(match all_snaps with
61
+
| d1 :: d2 :: _ -> (d2, d1) (* older first *)
62
+
| _ -> Printf.eprintf "Not enough snapshots\n"; exit 1)
63
+
in
64
+
let key1 = Fpath.basename snap1_dir in
65
+
let key2 = Fpath.basename snap2_dir in
66
+
(* Load snapshot metadata *)
67
+
let snap1 = Day11_batch.Snapshot.load snap1_dir in
68
+
let snap2 = Day11_batch.Snapshot.load snap2_dir in
69
+
Printf.printf "Comparing snapshots:\n";
70
+
Printf.printf " Old: %s" key1;
71
+
(match snap1 with
72
+
| Ok s -> Printf.printf " (%s)" s.created | _ -> ());
73
+
Printf.printf "\n";
74
+
Printf.printf " New: %s" key2;
75
+
(match snap2 with
76
+
| Ok s -> Printf.printf " (%s)" s.created | _ -> ());
77
+
Printf.printf "\n\n";
78
+
(* Load solutions *)
79
+
let sols1 = version_map (load_solutions snap1_dir) in
80
+
let sols2 = version_map (load_solutions snap2_dir) in
81
+
let tbl1 = Hashtbl.create (List.length sols1) in
82
+
List.iter (fun (name, v) -> Hashtbl.replace tbl1 name v) sols1;
83
+
let tbl2 = Hashtbl.create (List.length sols2) in
84
+
List.iter (fun (name, v) -> Hashtbl.replace tbl2 name v) sols2;
85
+
(* Collect all package names *)
86
+
let all_names = Hashtbl.create 64 in
87
+
Hashtbl.iter (fun k _ -> Hashtbl.replace all_names k ()) tbl1;
88
+
Hashtbl.iter (fun k _ -> Hashtbl.replace all_names k ()) tbl2;
89
+
let names = Hashtbl.fold (fun k () acc -> k :: acc) all_names []
90
+
|> List.sort String.compare in
91
+
(* Categorize changes *)
92
+
let added = ref [] in
93
+
let removed = ref [] in
94
+
let version_changed = ref [] in
95
+
let solve_changed = ref [] in
96
+
let unchanged = ref 0 in
97
+
List.iter (fun name ->
98
+
match Hashtbl.find_opt tbl1 name, Hashtbl.find_opt tbl2 name with
99
+
| None, Some (ver, solved, _) ->
100
+
added := (name, ver, solved) :: !added
101
+
| Some (ver, solved, _), None ->
102
+
removed := (name, ver, solved) :: !removed
103
+
| Some (v1, s1, _), Some (v2, s2, _) ->
104
+
if v1 <> v2 then
105
+
version_changed := (name, v1, v2) :: !version_changed
106
+
else if s1 <> s2 then
107
+
solve_changed := (name, s1, s2) :: !solve_changed
108
+
else
109
+
incr unchanged
110
+
| None, None -> ()
111
+
) names;
112
+
(* Print results *)
113
+
if !version_changed <> [] then begin
114
+
Printf.printf "Version changes:\n";
115
+
List.iter (fun (name, v1, v2) ->
116
+
Printf.printf " %s: %s -> %s\n" name v1 v2
117
+
) (List.rev !version_changed);
118
+
Printf.printf "\n"
119
+
end;
120
+
if !added <> [] then begin
121
+
Printf.printf "Added:\n";
122
+
List.iter (fun (name, ver, solved) ->
123
+
Printf.printf " %s.%s%s\n" name ver
124
+
(if solved then "" else " (solve failed)")
125
+
) (List.rev !added);
126
+
Printf.printf "\n"
127
+
end;
128
+
if !removed <> [] then begin
129
+
Printf.printf "Removed:\n";
130
+
List.iter (fun (name, ver, solved) ->
131
+
Printf.printf " %s.%s%s\n" name ver
132
+
(if solved then "" else " (was failing)")
133
+
) (List.rev !removed);
134
+
Printf.printf "\n"
135
+
end;
136
+
if !solve_changed <> [] then begin
137
+
Printf.printf "Solve status changed:\n";
138
+
List.iter (fun (name, was_ok, now_ok) ->
139
+
let status = if now_ok then "now solves" else "now fails" in
140
+
ignore was_ok;
141
+
Printf.printf " %s: %s\n" name status
142
+
) (List.rev !solve_changed);
143
+
Printf.printf "\n"
144
+
end;
145
+
Printf.printf "Summary: %d unchanged, %d version changes, %d added, %d removed, %d solve changes\n"
146
+
!unchanged (List.length !version_changed)
147
+
(List.length !added) (List.length !removed) (List.length !solve_changed);
148
+
0
149
+
150
+
let snap1_term =
151
+
let doc = "First snapshot key (default: second most recent)" in
152
+
Arg.(value & opt (some string) None & info [ "from" ] ~docv:"KEY" ~doc)
153
+
154
+
let snap2_term =
155
+
let doc = "Second snapshot key (default: most recent)" in
156
+
Arg.(value & opt (some string) None & info [ "to" ] ~docv:"KEY" ~doc)
157
+
158
+
let cmd =
159
+
let doc = "Compare two snapshots within a profile" in
160
+
let info = Cmd.info "diff" ~doc in
161
+
Cmd.v info
162
+
Term.(const run $ Common.profile_term $ Common.profile_dir_term
163
+
$ snap1_term $ snap2_term)
+71
-156
bin/cmd_gc.ml
+71
-156
bin/cmd_gc.ml
···
1
-
(** gc command: reclaim disk space *)
1
+
(** gc command: reclaim disk space from the shared cache *)
2
2
3
3
open Cmdliner
4
4
···
10
10
String.trim line
11
11
with _ -> "?"
12
12
13
-
let run profile_name profile_dir delete_orphans =
14
-
match Common.load_profile ~profile_dir ~name:profile_name with
15
-
| Error (`Msg e) -> Printf.eprintf "Error: %s\n%!" e; 1
16
-
| Ok (_profile, paths) ->
17
-
let cache_dir = paths.cache_dir in
18
-
let os_dir = paths.os_dir in
19
-
let snapshot_dir = Common.latest_snapshot_dir paths in
13
+
let run profile_dir before_days delete =
14
+
let pdir = Common.resolve_profile_dir profile_dir in
15
+
let cache_dir = Fpath.(pdir / "cache") in
20
16
Printf.printf "=== Garbage Collection ===\n\n";
21
-
Printf.printf "Disk usage:\n";
22
-
Printf.printf " Cache dir: %s\n"
17
+
Printf.printf "Cache: %s\n" (Fpath.to_string cache_dir);
18
+
Printf.printf " Size: %s\n\n"
23
19
(du (Printf.sprintf "du -sh %s 2>/dev/null | cut -f1"
24
20
(Fpath.to_string cache_dir)));
25
-
Printf.printf " Filesystem: %s\n\n"
26
-
(du "df -h . 2>/dev/null | tail -1 | awk '{print $4 \" free of \" $2}'");
27
21
(* 1. Clean stale temp dirs *)
28
22
let n_stale = Day11_lib.Gc.gc_stale_temp_dirs () in
29
23
if n_stale > 0 then
30
24
Printf.printf "Cleaned %d stale overlay temp dirs\n\n" n_stale;
31
-
(* 2. GC old solution caches -- keep the 3 most recent *)
32
-
(match snapshot_dir with
33
-
| Some snap_dir ->
34
-
let solutions_dir = Fpath.(snap_dir / "solutions") in
35
-
(match Bos.OS.Dir.contents solutions_dir with
36
-
| Ok dirs ->
37
-
let dirs = dirs
38
-
|> List.filter (fun p -> Bos.OS.Dir.exists p |> Result.get_ok)
39
-
|> List.sort (fun a b ->
40
-
let ma = try (Unix.stat (Fpath.to_string a)).Unix.st_mtime
41
-
with _ -> 0.0 in
42
-
let mb = try (Unix.stat (Fpath.to_string b)).Unix.st_mtime
43
-
with _ -> 0.0 in
44
-
compare mb ma)
45
-
in
46
-
if List.length dirs > 3 then begin
47
-
let to_delete = List.filteri (fun i _ -> i >= 3) dirs in
48
-
Printf.printf "Solution caches: keeping 3 of %d, deleting %d\n"
49
-
(List.length dirs) (List.length to_delete);
50
-
List.iter (fun d ->
51
-
Printf.printf " Deleting %s\n" (Fpath.basename d);
52
-
ignore (Sys.command (Printf.sprintf "rm -rf %s"
53
-
(Fpath.to_string d)))
54
-
) to_delete;
55
-
Printf.printf "\n"
56
-
end else
57
-
Printf.printf "Solution caches: %d (keeping all)\n\n"
58
-
(List.length dirs)
59
-
| Error _ -> ())
60
-
| None ->
61
-
Printf.printf "No snapshot found, skipping solution GC\n\n");
62
-
(* 3. GC old run dirs -- keep last 10 *)
63
-
(match snapshot_dir with
64
-
| Some snap_dir ->
65
-
let runs_dir = Fpath.(snap_dir / "runs") in
66
-
(match Bos.OS.Dir.contents runs_dir with
67
-
| Ok dirs ->
68
-
let dirs = dirs
69
-
|> List.filter (fun p -> Bos.OS.Dir.exists p |> Result.get_ok)
70
-
|> List.sort (fun a b ->
71
-
compare (Fpath.to_string b) (Fpath.to_string a))
72
-
in
73
-
if List.length dirs > 10 then begin
74
-
let to_delete = List.filteri (fun i _ -> i >= 10) dirs in
75
-
Printf.printf "Run dirs: keeping 10 of %d, deleting %d\n"
76
-
(List.length dirs) (List.length to_delete);
77
-
List.iter (fun d ->
78
-
ignore (Bos.OS.Path.delete ~recurse:true d)
79
-
) to_delete;
80
-
Printf.printf "\n"
81
-
end else
82
-
Printf.printf "Run dirs: %d (keeping all)\n\n" (List.length dirs)
83
-
| Error _ -> ())
84
-
| None ->
85
-
Printf.printf "No snapshot found, skipping run GC\n\n");
86
-
(* 4. Find referenced build layers from latest run's build.jsonl *)
87
-
let latest_run_dir =
88
-
match snapshot_dir with
89
-
| None -> None
90
-
| Some snap_dir ->
91
-
let runs_dir = Fpath.(snap_dir / "runs") in
92
-
match Bos.OS.Dir.contents runs_dir with
93
-
| Ok dirs ->
94
-
dirs
95
-
|> List.filter (fun p -> Bos.OS.Dir.exists p |> Result.get_ok)
96
-
|> List.sort (fun a b ->
97
-
compare (Fpath.to_string b) (Fpath.to_string a))
98
-
|> (function d :: _ -> Some d | [] -> None)
99
-
| Error _ -> None
25
+
(* 2. Scan layers by last-used time *)
26
+
let cutoff = Unix.gettimeofday () -. (float before_days *. 86400.) in
27
+
let os_dirs =
28
+
match Bos.OS.Dir.contents cache_dir with
29
+
| Error _ -> []
30
+
| Ok entries ->
31
+
List.filter (fun p ->
32
+
let name = Fpath.basename p in
33
+
name <> "base" && name <> "opam-build-bin" &&
34
+
(Bos.OS.Dir.exists p |> Result.get_ok)
35
+
) entries
100
36
in
101
-
let os_dir_s = Fpath.to_string os_dir in
102
-
(match latest_run_dir with
103
-
| Some run_dir ->
104
-
(* Collect referenced layer names from build.jsonl *)
105
-
let build_jsonl = Fpath.(run_dir / "build.jsonl") in
106
-
let referenced =
107
-
if Bos.OS.File.exists build_jsonl |> Result.get_ok then begin
108
-
let ic = open_in (Fpath.to_string build_jsonl) in
109
-
let refs = ref [] in
110
-
(try while true do
111
-
let line = input_line ic in
112
-
try
113
-
let json = Yojson.Safe.from_string line in
114
-
let open Yojson.Safe.Util in
115
-
let hash = json |> member "hash" |> to_string in
116
-
let layer_name = "build-" ^ String.sub hash 0 12 in
117
-
refs := layer_name :: !refs
118
-
with _ -> ()
119
-
done with End_of_file -> close_in ic);
120
-
List.sort_uniq String.compare !refs
121
-
end else []
122
-
in
123
-
Printf.printf "Build layers referenced in latest run: %d\n"
124
-
(List.length referenced);
125
-
if delete_orphans && referenced <> [] then begin
126
-
let result = Day11_lib.Gc.gc_build_layers ~os_dir:os_dir_s
127
-
~referenced in
128
-
Printf.printf " Total: %d, Kept: %d, Deleted: %d\n\n"
129
-
result.total result.kept result.deleted
130
-
end else if referenced <> [] then begin
131
-
(* Just count orphans *)
132
-
let all_layers =
133
-
try Sys.readdir os_dir_s |> Array.to_list
134
-
|> List.filter (fun n ->
135
-
String.length n > 6 && String.sub n 0 6 = "build-"
136
-
&& not (Filename.check_suffix n ".lock"))
137
-
with _ -> [] in
138
-
let referenced_set = Hashtbl.create (List.length referenced) in
139
-
List.iter (fun r -> Hashtbl.replace referenced_set r ()) referenced;
140
-
let orphans = List.filter (fun n ->
141
-
not (Hashtbl.mem referenced_set n)) all_layers in
142
-
Printf.printf " Total: %d, Referenced: %d, Orphaned: %d\n"
143
-
(List.length all_layers) (List.length referenced)
144
-
(List.length orphans);
145
-
if orphans <> [] then
146
-
Printf.printf " Run with --delete-orphans to remove them.\n\n"
147
-
else
148
-
Printf.printf "\n"
149
-
end else
150
-
Printf.printf " No run data to check references.\n\n";
151
-
(* 5. GC odoc store universes *)
152
-
let store_u = Filename.concat os_dir_s "odoc-store/odoc-out/u" in
153
-
if Sys.file_exists store_u then begin
154
-
let all_universes =
155
-
try Sys.readdir store_u |> Array.to_list
156
-
|> List.filter (fun n ->
157
-
Sys.is_directory (Filename.concat store_u n))
158
-
with _ -> [] in
159
-
Printf.printf "Odoc store: %d universe hashes in u/\n"
160
-
(List.length all_universes);
161
-
if delete_orphans then begin
162
-
Printf.printf " (universe GC requires solution data, skipping)\n\n"
163
-
end else
164
-
Printf.printf "\n"
165
-
end
166
-
| None ->
167
-
Printf.printf "No run data found.\n\n");
168
-
(* 6. Summary *)
169
-
Printf.printf "Cache dir: %s\n"
37
+
let total_layers = ref 0 in
38
+
let old_layers = ref 0 in
39
+
let old_size = ref 0 in
40
+
let deleted_count = ref 0 in
41
+
List.iter (fun os_dir ->
42
+
let os_name = Fpath.basename os_dir in
43
+
let entries =
44
+
try Sys.readdir (Fpath.to_string os_dir) |> Array.to_list
45
+
with _ -> [] in
46
+
let layers = List.filter (fun name ->
47
+
(* Layer dirs: 12-char hex or build-<hex> (legacy) *)
48
+
let is_hex c = (c >= '0' && c <= '9') || (c >= 'a' && c <= 'f') in
49
+
(String.length name = 12 && String.for_all is_hex name)
50
+
|| (String.length name > 6 && String.sub name 0 6 = "build-")
51
+
) entries in
52
+
total_layers := !total_layers + List.length layers;
53
+
List.iter (fun name ->
54
+
let layer_dir = Fpath.(os_dir / name) in
55
+
let last_used = match Day11_layer.Last_used.get layer_dir with
56
+
| Some t -> t | None -> 0.0 in
57
+
if last_used < cutoff then begin
58
+
incr old_layers;
59
+
let size =
60
+
try (Unix.stat (Fpath.to_string layer_dir)).Unix.st_size
61
+
with _ -> 0 in
62
+
old_size := !old_size + size;
63
+
if delete then begin
64
+
ignore (Sys.command (Printf.sprintf "sudo rm -rf %s"
65
+
(Fpath.to_string layer_dir)));
66
+
incr deleted_count
67
+
end
68
+
end
69
+
) layers;
70
+
Printf.printf " %s: %d layers\n" os_name (List.length layers)
71
+
) os_dirs;
72
+
Printf.printf "\nTotal layers: %d\n" !total_layers;
73
+
Printf.printf "Layers last used before %d days ago: %d\n"
74
+
before_days !old_layers;
75
+
if delete then
76
+
Printf.printf "Deleted: %d layers\n" !deleted_count
77
+
else if !old_layers > 0 then
78
+
Printf.printf "Run with --delete to remove them.\n";
79
+
Printf.printf "\nCache after: %s\n"
170
80
(du (Printf.sprintf "du -sh %s 2>/dev/null | cut -f1"
171
81
(Fpath.to_string cache_dir)));
172
82
0
173
83
174
-
let delete_orphans_term =
175
-
let doc = "Actually delete orphaned layers (default: report only)" in
176
-
Arg.(value & flag & info [ "delete-orphans" ] ~doc)
84
+
let before_term =
85
+
let doc = "Delete layers not used in the last N days (default 30)" in
86
+
Arg.(value & opt int 30 & info [ "before" ] ~docv:"DAYS" ~doc)
87
+
88
+
let delete_term =
89
+
let doc = "Actually delete old layers (default: report only)" in
90
+
Arg.(value & flag & info [ "delete" ] ~doc)
177
91
178
92
let cmd =
179
-
let info = Cmd.info "gc" ~doc:"Reclaim disk space and clean up" in
180
-
let term = Term.(const run $ Common.profile_term $ Common.profile_dir_term
181
-
$ delete_orphans_term) in
93
+
let info = Cmd.info "gc"
94
+
~doc:"Reclaim disk space by removing old layers from the shared cache" in
95
+
let term = Term.(const run $ Common.profile_dir_term
96
+
$ before_term $ delete_term) in
182
97
Cmd.v info term
+10
-6
bin/cmd_log.ml
+10
-6
bin/cmd_log.ml
···
1
1
(** log command: view build or doc log *)
2
2
3
3
open Cmdliner
4
+
module Layer = Day11_layer.Layer
4
5
5
-
let resolve_layer os_dir arg =
6
-
(* If it looks like a layer dir name (starts with "build-") and exists, use it *)
6
+
let resolve_layer os_dir ~packages_dir arg =
7
+
(* If it looks like a layer dir name and exists, use it *)
7
8
let layer_dir = Fpath.(os_dir / arg) in
8
9
if Bos.OS.Dir.exists layer_dir |> Result.get_ok then
9
10
Some arg
10
11
else begin
11
12
(* Try to look up as a package name in the packages dir *)
12
-
let packages_dir = Fpath.(os_dir / "packages") in
13
13
let symlinks = Day11_layer.Scan.list_package_symlinks
14
14
~exclude:["blessed-build"; "blessed-docs"; "history.jsonl"]
15
15
packages_dir arg in
···
37
37
| Error (`Msg e) -> Printf.eprintf "Error: %s\n%!" e; 1
38
38
| Ok (_profile, paths) ->
39
39
let os_dir = paths.os_dir in
40
-
let layer = match resolve_layer os_dir arg with
40
+
let packages_dir = match Common.latest_snapshot_dir paths with
41
+
| Some sd -> Fpath.(sd / "packages")
42
+
| None -> Fpath.(os_dir / "packages") in
43
+
let layer = match resolve_layer os_dir ~packages_dir arg with
41
44
| Some l -> l
42
45
| None ->
43
46
Printf.eprintf "No layer or package found for %s\n" arg;
44
47
exit 1
45
48
in
46
-
let layer_dir = Fpath.(os_dir / layer) in
49
+
let ly = Layer.of_hash ~os_dir layer in
50
+
let layer_dir = Layer.dir ly in
47
51
(* Try layer.log first (build), then odoc-voodoo-all.log (doc) *)
48
52
let log_file =
49
-
let build_log = Fpath.(layer_dir / "layer.log") in
53
+
let build_log = Layer.log_path ly in
50
54
let doc_log = Fpath.(layer_dir / "odoc-voodoo-all.log") in
51
55
if Bos.OS.File.exists build_log |> Result.get_ok then Some build_log
52
56
else if Bos.OS.File.exists doc_log |> Result.get_ok then Some doc_log
+31
-3
bin/cmd_profile.ml
+31
-3
bin/cmd_profile.ml
···
62
62
info [ "os-version" ] ~docv:"VER" ~doc)
63
63
64
64
let driver_compiler_term =
65
-
let doc = "Compiler for doc driver tools" in
66
-
Arg.(value & opt string "ocaml-base-compiler.5.4.1" &
65
+
let doc = "Compiler for doc driver tools (default: auto-detect from solutions)" in
66
+
Arg.(value & opt string "" &
67
67
info [ "driver-compiler" ] ~docv:"PKG" ~doc)
68
68
69
69
let run_create profile_dir name opam_repositories odoc_repo opam_build_repo
···
91
91
driver_compiler;
92
92
extra_pins = [];
93
93
patches_dir = None;
94
+
base_image_digest = None;
95
+
base_image_updated = None;
94
96
} in
95
97
match Day11_batch.Profile.save ~dir profile with
96
98
| Ok () ->
···
159
161
let info = Cmd.info "delete" ~doc in
160
162
Cmd.v info Term.(const run_delete $ profile_dir_term $ name_term)
161
163
164
+
(* ── refresh-base ──────────────────────────────────────────────── *)
165
+
166
+
let run_refresh_base profile_dir name =
167
+
let dir = Fpath.(resolve_profile_dir profile_dir / "profiles") in
168
+
match Day11_batch.Profile.load ~dir ~name with
169
+
| Error (`Msg e) -> Printf.eprintf "Error: %s\n%!" e; 1
170
+
| Ok profile ->
171
+
Printf.printf "Resolving digest for %s (this may take ~15s)...\n%!"
172
+
(Day11_batch.Profile.base_image_tag profile);
173
+
match Day11_batch.Profile.refresh_base_digest profile with
174
+
| Error (`Msg e) -> Printf.eprintf "Error: %s\n%!" e; 1
175
+
| Ok updated ->
176
+
match Day11_batch.Profile.save ~dir updated with
177
+
| Ok () ->
178
+
Printf.printf "Base image digest updated:\n %s\n%!"
179
+
(Option.value ~default:"?" updated.base_image_digest);
180
+
0
181
+
| Error (`Msg e) ->
182
+
Printf.eprintf "Error saving: %s\n%!" e; 1
183
+
184
+
let refresh_base_cmd =
185
+
let doc = "Resolve and pin the base Docker image digest from the registry" in
186
+
let info = Cmd.info "refresh-base" ~doc in
187
+
Cmd.v info Term.(const run_refresh_base $ profile_dir_term $ name_term)
188
+
162
189
(* ── group ─────────────────────────────────────────────────────── *)
163
190
164
191
let cmd =
165
192
let doc = "Manage analysis profiles" in
166
193
let info = Cmd.info "profile" ~doc in
167
-
Cmd.group info [ create_cmd; show_cmd; list_cmd; delete_cmd ]
194
+
Cmd.group info [ create_cmd; show_cmd; list_cmd; delete_cmd;
195
+
refresh_base_cmd ]
+3
-3
bin/cmd_query.ml
+3
-3
bin/cmd_query.ml
···
1
1
(** query command: show detailed info for a package *)
2
2
3
3
open Cmdliner
4
+
module Layer = Day11_layer.Layer
4
5
5
6
let show_layers_from_symlinks ~os_dir ~packages_dir ~pkg_str =
6
7
let symlinks = Day11_layer.Scan.list_package_symlinks
···
12
13
end else begin
13
14
Printf.printf "Layers for %s (%d):\n\n" pkg_str (List.length symlinks);
14
15
List.iter (fun (name, _target) ->
15
-
let layer_dir = Fpath.(os_dir / name) in
16
-
let layer_json = Fpath.(layer_dir / "layer.json") in
17
-
match Day11_layer.Meta.load layer_json with
16
+
let layer = Layer.of_hash ~os_dir name in
17
+
match Day11_layer.Meta.load (Layer.meta_path layer) 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"
+9
-4
bin/cmd_rdeps.ml
+9
-4
bin/cmd_rdeps.ml
···
2
2
3
3
open Cmdliner
4
4
5
-
let run opam_repository package =
5
+
let run profile_name profile_dir package =
6
+
match Common.load_profile ~profile_dir ~name:profile_name with
7
+
| Error (`Msg e) -> Printf.eprintf "Error: %s\n%!" e; 1
8
+
| Ok (profile, _paths) ->
6
9
let _git_packages, repos_with_shas, _opam_env =
7
-
Common.setup_solver opam_repository in
10
+
Common.setup_solver profile.opam_repositories in
8
11
let pkg = OpamPackage.of_string package in
9
12
let results = Day11_solver_pool.Solver_pool.solve_many ~np:1
10
13
~repos:repos_with_shas [ pkg ] in
···
14
17
| None ->
15
18
Printf.eprintf "No result for %s\n" package; 1
16
19
| Some (Ok result) ->
17
-
let rdeps = Day11_solution.Rdeps.find [ result.Day11_solution.Solve_result.build_deps ] pkg in
20
+
let rdeps = Day11_solution.Rdeps.find
21
+
[ result.Day11_solution.Solve_result.build_deps ] pkg in
18
22
if OpamPackage.Set.is_empty rdeps then
19
23
Printf.printf "No reverse dependencies for %s\n" package
20
24
else begin
···
31
35
32
36
let cmd =
33
37
let info = Cmd.info "rdeps" ~doc:"Find reverse dependencies" in
34
-
let term = Term.(const run $ Common.opam_repo_term $ package_term) in
38
+
let term = Term.(const run $ Common.profile_term $ Common.profile_dir_term
39
+
$ package_term) in
35
40
Cmd.v info term
+54
bin/cmd_snapshots.ml
+54
bin/cmd_snapshots.ml
···
1
+
(** snapshots command: list snapshots for a profile *)
2
+
3
+
open Cmdliner
4
+
5
+
let run profile_name profile_dir =
6
+
match Common.load_profile ~profile_dir ~name:profile_name with
7
+
| Error (`Msg e) -> Printf.eprintf "Error: %s\n%!" e; 1
8
+
| Ok (_profile, paths) ->
9
+
let snaps = Common.snapshot_dirs_by_recency paths in
10
+
if snaps = [] then begin
11
+
Printf.printf "No snapshots for profile '%s'\n%!" profile_name;
12
+
0
13
+
end else begin
14
+
Printf.printf "Snapshots for profile '%s' (%d):\n\n" profile_name
15
+
(List.length snaps);
16
+
List.iter (fun snap_dir ->
17
+
let key = Fpath.basename snap_dir in
18
+
let created = match Day11_batch.Snapshot.load snap_dir with
19
+
| Ok s -> s.created
20
+
| Error _ -> "?"
21
+
in
22
+
let n_solutions =
23
+
let sol_dir = Day11_batch.Snapshot.solutions_dir snap_dir in
24
+
match Bos.OS.Dir.contents sol_dir with
25
+
| Ok files ->
26
+
List.length (List.filter (fun p ->
27
+
Fpath.has_ext ".json" p && Fpath.basename p <> "repos.json"
28
+
) files)
29
+
| Error _ -> 0
30
+
in
31
+
let n_runs =
32
+
let runs_dir = Day11_batch.Snapshot.runs_dir snap_dir in
33
+
match Bos.OS.Dir.contents runs_dir with
34
+
| Ok dirs -> List.length dirs
35
+
| Error _ -> 0
36
+
in
37
+
let repos = match Day11_batch.Snapshot.load snap_dir with
38
+
| Ok s ->
39
+
String.concat ", " (List.map (fun (_, sha) ->
40
+
String.sub sha 0 (min 12 (String.length sha))
41
+
) s.repos)
42
+
| Error _ -> "?"
43
+
in
44
+
Printf.printf " %s %s %d solutions, %d runs [%s]\n"
45
+
key created n_solutions n_runs repos
46
+
) snaps;
47
+
0
48
+
end
49
+
50
+
let cmd =
51
+
let doc = "List snapshots for a profile" in
52
+
let info = Cmd.info "snapshots" ~doc in
53
+
Cmd.v info
54
+
Term.(const run $ Common.profile_term $ Common.profile_dir_term)
+14
bin/common.ml
+14
bin/common.ml
···
123
123
| (p, _) :: _ -> Some p
124
124
| [] -> None
125
125
126
+
let snapshot_dirs_by_recency (paths : paths) =
127
+
match Bos.OS.Dir.contents paths.snapshots_base with
128
+
| Error _ -> []
129
+
| Ok entries ->
130
+
entries
131
+
|> List.filter (fun p -> Bos.OS.Dir.exists p |> Result.get_ok)
132
+
|> List.filter_map (fun p ->
133
+
try
134
+
let stat = Unix.stat (Fpath.to_string p) in
135
+
Some (p, stat.Unix.st_mtime)
136
+
with Unix.Unix_error _ -> None)
137
+
|> List.sort (fun (_, t1) (_, t2) -> compare t2 t1)
138
+
|> List.map fst
139
+
126
140
let read_pins_from_dir dir =
127
141
let opam_files = Sys.readdir dir |> Array.to_list
128
142
|> List.filter (fun f -> Filename.check_suffix f ".opam") in
+2
bin/main.ml
+2
bin/main.ml
+3
-21
day11.opam
+3
-21
day11.opam
···
1
1
# This file is generated by dune, edit dune-project instead
2
2
opam-version: "2.0"
3
-
synopsis: "Containerized opam package builder"
4
-
description:
5
-
"Build opam packages in isolated containers with layered caching"
6
-
maintainer: ["Maintainer Name <maintainer@example.com>"]
7
-
authors: ["Author Name <author@example.com>"]
8
-
license: "LICENSE"
3
+
synopsis: "OCaml package build and documentation system"
9
4
depends: [
10
-
"ocaml" {>= "5.3.0"}
11
-
"dune" {>= "3.17"}
12
-
"bos"
13
-
"eio_main"
14
-
"fpath"
15
-
"logs"
16
-
"rresult"
17
-
"yojson"
18
-
"opam-0install"
19
-
"opam-format"
20
-
"cmdliner" {< "2.0.0"}
21
-
"dockerfile"
22
-
"str"
23
-
"alcotest" {with-test}
5
+
"dune" {>= "3.20"}
24
6
"odoc" {with-doc}
25
7
]
26
8
build: [
···
37
19
"@doc" {with-doc}
38
20
]
39
21
]
40
-
dev-repo: "https://tangled.org/jon.recoil.org/day11"
22
+
x-maintenance-intent: ["(latest)"]
+6
-1
doc-pages/batch.mld
+6
-1
doc-pages/batch.mld
···
12
12
layers and cascades recovery to dependents whose failing dependency has
13
13
since succeeded. {!Day11_batch.Summary} aggregates build and doc outcomes, records
14
14
per-package history, generates the status index, and prints a
15
-
human-readable summary.
15
+
human-readable summary. {!Day11_batch.Profile} manages named analysis
16
+
configurations (repositories, targets, platform settings) stored as
17
+
JSON files. {!Day11_batch.Snapshot} captures point-in-time state of all
18
+
opam repositories within a profile, keyed by commit SHAs.
16
19
17
20
Sits near the top of the dependency hierarchy, depending on
18
21
{!day11-opam-build}, {!page-solution}, {!day11-lib}, {!day11-layer},
···
26
29
Day11_batch.Blessing
27
30
Day11_batch.Rerun
28
31
Day11_batch.Summary
32
+
Day11_batch.Profile
33
+
Day11_batch.Snapshot
29
34
}
+5
doc-pages/doc.mld
+5
doc-pages/doc.mld
···
18
18
{!Day11_doc.Universe} tracks universe directories for documentation GC.
19
19
{!Day11_doc.Doc_meta} is the sidecar metadata for doc layers ([doc.json]),
20
20
recording the package name, phase, and dependencies.
21
+
{!Day11_doc.Doc_build} provides stateless per-package doc build
22
+
primitives (compile, link, doc-all) that take explicit inputs and
23
+
produce results — the building blocks for both the DAG executor and
24
+
external pipeline systems like OCurrent.
21
25
22
26
Sits near the top of the dependency hierarchy, depending on
23
27
{!page-opam_build}, {!page-opam_layer}, {!page-layer},
···
27
31
28
32
{!modules:
29
33
Day11_doc.Generate
34
+
Day11_doc.Doc_build
30
35
Day11_doc.Doc_deps
31
36
Day11_doc.Doc_meta
32
37
Day11_doc.Phase
+14
-8
doc-pages/layer.mld
+14
-8
doc-pages/layer.mld
···
1
1
{0 day11-layer}
2
2
3
3
Generic layered storage on disk. A layer is a directory containing a
4
-
[fs/] tree (the filesystem delta) plus metadata files. {!Day11_layer.Meta}
5
-
serializes per-layer metadata ([layer.json]) covering exit status,
6
-
parent hashes, timing, and disk usage. {!Day11_layer.Dir} owns the
7
-
[build-XXXXXXXXXXXX] naming convention. {!Day11_layer.Base} represents the
4
+
[fs/] tree (the filesystem delta) plus metadata files.
5
+
6
+
The core type {!Day11_layer.Layer} represents a layer on disk via its
7
+
content hash and directory path, with helpers to check existence and
8
+
status. {!Day11_layer.Meta} serializes per-layer metadata ([layer.json])
9
+
covering exit status, parent hashes, timing, and disk usage.
10
+
{!Day11_layer.Dir} owns the naming convention that derives directory
11
+
names from content hashes. {!Day11_layer.Base} represents the
8
12
foundational rootfs image at the bottom of every overlay stack.
9
13
{!Day11_layer.Hash} computes content-addressed cache keys from layer inputs.
10
14
{!Day11_layer.Stack} merges multiple layers into one directory via hardlinked
11
15
copies, and plans overlayfs lowerdir layouts that fit kernel page-size
12
-
limits. {!Day11_layer.Scan} enumerates layers from the on-disk cache. {!Day11_layer.Import}
13
-
extracts layer filesystems from Docker images. {!Day11_layer.Last_used} maintains
14
-
a cheap mtime-based sentinel for LRU eviction. {!Day11_layer.Symlinks} maintains
15
-
per-identifier tracking symlinks for layer discovery.
16
+
limits. {!Day11_layer.Scan} enumerates layers from the on-disk cache.
17
+
{!Day11_layer.Import} extracts layer filesystems from Docker images.
18
+
{!Day11_layer.Last_used} maintains a cheap mtime-based sentinel for LRU
19
+
eviction. {!Day11_layer.Symlinks} maintains per-identifier tracking
20
+
symlinks for layer discovery.
16
21
17
22
Depends on {!day11-exec} for subprocess and sudo access. Has no opam
18
23
or package-domain knowledge — domain-specific metadata lives in
···
21
26
{1 Modules}
22
27
23
28
{!modules:
29
+
Day11_layer.Layer
24
30
Day11_layer.Meta
25
31
Day11_layer.Dir
26
32
Day11_layer.Base
+236
doc-pages/ocurrent_sketch.ml
+236
doc-pages/ocurrent_sketch.ml
···
1
+
(* SKETCH: day11 as an OCurrent pipeline
2
+
3
+
This is not compilable code — it's a design sketch showing how
4
+
day11's libraries would map onto OCurrent's abstractions.
5
+
6
+
The key insight: day11's layer hashes are deterministic from
7
+
inputs, so they serve as OCurrent cache keys directly. *)
8
+
9
+
open Current.Syntax
10
+
11
+
(* ── Cache modules ─────────────────────────────────────────────── *)
12
+
13
+
(* Each layer type gets a Current_cache.BUILDER that:
14
+
- Uses the pre-computed layer hash as the cache key
15
+
- Checks for the layer on disk before building
16
+
- Calls the clean Doc_build/Build_layer primitive to do the work *)
17
+
18
+
module Build_cache = Current_cache.Make (struct
19
+
type t = {
20
+
env : Eio_unix.Stdenv.base;
21
+
benv : Day11_opam_build.Types.build_env;
22
+
}
23
+
24
+
module Key = struct
25
+
type t = { pkg : OpamPackage.t; hash : string }
26
+
let digest t = t.hash
27
+
end
28
+
29
+
module Value = struct
30
+
type t = Fpath.t (* layer dir *)
31
+
let marshal p = Fpath.to_string p
32
+
let unmarshal s = Fpath.v s
33
+
end
34
+
35
+
let id = "day11-build"
36
+
37
+
let pp f key = Fmt.pf f "build %s" (OpamPackage.to_string key.Key.pkg)
38
+
39
+
let auto_cancel = false
40
+
41
+
let build ctx job key =
42
+
Current.Job.log job "Building %s" (OpamPackage.to_string key.pkg);
43
+
let layer = Day11_layer.Layer.of_hash ~os_dir:ctx.benv.os_dir key.hash in
44
+
if Day11_layer.Layer.exists layer then
45
+
Lwt.return_ok (Day11_layer.Layer.dir layer)
46
+
else
47
+
(* Call the build primitive *)
48
+
match Day11_opam_build.Build_layer.build ctx.env ctx.benv
49
+
(* ... build args ... *)
50
+
() with
51
+
| Day11_opam_build.Types.Success _bl -> Lwt.return_ok layer_dir
52
+
| _ -> Lwt.return_error (`Msg "build failed")
53
+
end)
54
+
55
+
module Compile_cache = Current_cache.Make (struct
56
+
type t = {
57
+
env : Eio_unix.Stdenv.base;
58
+
benv : Day11_opam_build.Types.build_env;
59
+
config : Day11_doc.Doc_build.doc_config;
60
+
}
61
+
62
+
module Key = struct
63
+
type t = {
64
+
pkg : OpamPackage.t;
65
+
hash : string;
66
+
build_layer : Fpath.t;
67
+
dep_compile_layers : Fpath.t list;
68
+
}
69
+
let digest t = t.hash (* deterministic from inputs *)
70
+
end
71
+
72
+
module Value = struct
73
+
type t = Fpath.t
74
+
let marshal p = Fpath.to_string p
75
+
let unmarshal s = Fpath.v s
76
+
end
77
+
78
+
let id = "day11-compile"
79
+
let pp f key = Fmt.pf f "compile %s" (OpamPackage.to_string key.Key.pkg)
80
+
let auto_cancel = false
81
+
82
+
let build ctx _job key =
83
+
match Day11_doc.Doc_build.compile ctx.env ctx.benv
84
+
~config:ctx.config
85
+
~build_layer:key.build_layer
86
+
~dep_compile_layers:key.dep_compile_layers
87
+
~hash:key.hash key.pkg with
88
+
| Ok layer_dir -> Lwt.return_ok layer_dir
89
+
| Error msg -> Lwt.return_error (`Msg msg)
90
+
end)
91
+
92
+
module Link_cache = Current_cache.Make (struct
93
+
type t = {
94
+
env : Eio_unix.Stdenv.base;
95
+
benv : Day11_opam_build.Types.build_env;
96
+
config : Day11_doc.Doc_build.doc_config;
97
+
html_dir : Fpath.t;
98
+
}
99
+
100
+
module Key = struct
101
+
type t = {
102
+
pkg : OpamPackage.t;
103
+
hash : string;
104
+
build_layer : Fpath.t;
105
+
compile_layer : Fpath.t;
106
+
dep_compile_layers : Fpath.t list;
107
+
}
108
+
let digest t = t.hash
109
+
end
110
+
111
+
module Value = Current.Unit
112
+
113
+
let id = "day11-link"
114
+
let pp f key = Fmt.pf f "link %s" (OpamPackage.to_string key.Key.pkg)
115
+
let auto_cancel = false
116
+
117
+
let build ctx _job key =
118
+
match Day11_doc.Doc_build.link ctx.env ctx.benv
119
+
~config:ctx.config
120
+
~build_layer:key.build_layer
121
+
~compile_layer:key.compile_layer
122
+
~dep_compile_layers:key.dep_compile_layers
123
+
~html_dir:ctx.html_dir
124
+
~hash:key.hash key.pkg with
125
+
| Ok () -> Lwt.return_ok ()
126
+
| Error msg -> Lwt.return_error (`Msg msg)
127
+
end)
128
+
129
+
(* ── Pipeline ──────────────────────────────────────────────────── *)
130
+
131
+
(* The pipeline wires together:
132
+
1. Track opam-repo for changes
133
+
2. Solve all packages
134
+
3. Build all packages (fan out, DAG from deps)
135
+
4. Compile docs (fan out, DAG from compile deps)
136
+
5. Link docs (fan out, DAG from doc deps)
137
+
138
+
OCurrent handles scheduling, caching, parallelism, and the web UI. *)
139
+
140
+
let pipeline ~opam_repo ~config () =
141
+
(* 1. Track opam-repository HEAD *)
142
+
let repo = Current_git.Local.head_commit (Current.return opam_repo) in
143
+
144
+
(* 2. Solve — produces a map from package to solve result *)
145
+
let solutions =
146
+
let+ commit = repo in
147
+
let packages, repos_with_shas, env =
148
+
Day11_opam.Git_packages.of_repositories [ (opam_repo, None) ] in
149
+
(* Solve all packages in the small universe *)
150
+
let targets = Day11_batch.Targets.resolve ~small:true packages None in
151
+
List.filter_map (fun target ->
152
+
match Day11_solver.Solve.solve ~packages ~env target with
153
+
| Ok result -> Some (target, result)
154
+
| Error _ -> None
155
+
) targets
156
+
in
157
+
158
+
(* 3. Build — each package becomes a Current.t of its build layer path *)
159
+
let build_layers =
160
+
let+ solutions = solutions in
161
+
(* Compute the DAG and build all layers *)
162
+
let cache = Day11_opam_build.Hash_cache.create () in
163
+
let nodes = Day11_opam_build.Dag.build_dag cache
164
+
~base_hash:"..." solutions in
165
+
(* Each node's hash is deterministic — use as cache key *)
166
+
List.map (fun (node : Day11_opam_layer.Build.t) ->
167
+
(node.pkg, node.hash, Build_cache.get ctx { pkg = node.pkg; hash = node.hash })
168
+
) nodes
169
+
in
170
+
171
+
(* 4. Compile — each package's compile depends on its deps' compiles *)
172
+
(* This is where the DAG emerges from Current.t dependencies *)
173
+
let compile_layers =
174
+
let+ build_layers = build_layers in
175
+
List.map (fun (pkg, hash, build_layer) ->
176
+
let dep_compiles = (* look up deps' compile layers *) in
177
+
let+ build = build_layer
178
+
and+ deps = Current.list_seq dep_compiles in
179
+
Compile_cache.get ctx {
180
+
pkg; hash = compile_hash;
181
+
build_layer = build;
182
+
dep_compile_layers = deps;
183
+
}
184
+
) build_layers
185
+
in
186
+
187
+
(* 5. Link — depends on compile layer + doc-dep compile layers *)
188
+
let _links =
189
+
let+ compile_layers = compile_layers in
190
+
List.map (fun (pkg, compile_layer, doc_dep_compiles) ->
191
+
let+ compile = compile_layer
192
+
and+ deps = Current.list_seq doc_dep_compiles in
193
+
Link_cache.get ctx {
194
+
pkg; hash = link_hash;
195
+
build_layer = (* ... *);
196
+
compile_layer = compile;
197
+
dep_compile_layers = deps;
198
+
}
199
+
) compile_layers
200
+
in
201
+
202
+
Current.return ()
203
+
204
+
205
+
(* ── Notes ─────────────────────────────────────────────────────── *)
206
+
207
+
(* What OCurrent gives us for free:
208
+
- Reactive: re-runs when opam-repo changes
209
+
- Incremental: only rebuilds what changed (via cache key = layer hash)
210
+
- Parallel: independent Current.t values run concurrently
211
+
- Web UI: shows pipeline status, per-package progress
212
+
- Error propagation: failed deps cascade automatically
213
+
214
+
What day11 gives OCurrent:
215
+
- Clean build primitives (Doc_build.compile/link/doc_all)
216
+
- Content-addressed layer caching (layer hash = cache key)
217
+
- Overlayfs stacking for efficient dep assembly
218
+
- Deterministic hash computation (no post-hoc hash extraction)
219
+
220
+
The key architectural win: OCurrent's cache digest IS the layer hash.
221
+
No separate caching logic needed — the two systems align perfectly.
222
+
223
+
What's NOT needed from day11 in this model:
224
+
- dag_executor.ml (OCurrent does scheduling)
225
+
- Profile/Snapshot (OCurrent pipeline IS the profile)
226
+
- cmd_batch.ml (OCurrent replaces it)
227
+
- Summary/Status_index (OCurrent web UI replaces it)
228
+
229
+
What IS needed:
230
+
- Day11_solver.Solve.solve
231
+
- Day11_opam_build.Build_layer.build (or a cleaner primitive)
232
+
- Day11_doc.Doc_build.compile/link/doc_all
233
+
- Day11_layer.* (on-disk format)
234
+
- Day11_container.* (runc execution)
235
+
- Day11_runner.Run_in_layers.run (overlayfs assembly)
236
+
*)
+207
doc/doc_build.ml
+207
doc/doc_build.ml
···
1
+
module Build = Day11_opam_layer.Build
2
+
module Installed_files = Day11_opam_layer.Installed_files
3
+
4
+
let odoc_bin = "/home/opam/doc-tools/bin/odoc"
5
+
let odoc_md_bin = "/home/opam/doc-tools/bin/odoc-md"
6
+
7
+
type doc_config = {
8
+
driver_tool : Day11_opam_layer.Tool.t;
9
+
odoc_tool : Day11_opam_layer.Tool.t;
10
+
os_dir : Fpath.t;
11
+
blessed : bool;
12
+
}
13
+
14
+
let has_documentable_libs layer_dir =
15
+
Installed_files.scan_libs ~layer_dir <> []
16
+
17
+
(** Create tool binary mounts from driver and odoc tools. *)
18
+
let make_tool_mounts ~os_dir ~(driver_tool : Day11_opam_layer.Tool.t)
19
+
~(odoc_tool : Day11_opam_layer.Tool.t) =
20
+
let find name builds =
21
+
let switch = Day11_opam_build.Types.switch in
22
+
match List.find_map (fun (bl : Build.t) ->
23
+
let bin = Fpath.(Build.dir ~os_dir bl / "fs" / "home" / "opam"
24
+
/ ".opam" / switch / "bin" / name) in
25
+
if Bos.OS.File.exists bin |> Result.get_ok then Some bin
26
+
else None
27
+
) builds with
28
+
| Some p -> p
29
+
| None -> failwith (Printf.sprintf "Doc tool binary %s not found" name)
30
+
in
31
+
let mount src dst = Day11_container.Mount.bind_ro
32
+
~src:(Fpath.to_string src) dst in
33
+
[ mount (find "odoc" odoc_tool.builds) "/home/opam/doc-tools/bin/odoc";
34
+
mount (find "odoc-md" driver_tool.builds) "/home/opam/doc-tools/bin/odoc-md";
35
+
mount (find "odoc_driver_voodoo" driver_tool.builds)
36
+
"/home/opam/doc-tools/bin/odoc_driver_voodoo";
37
+
mount (find "sherlodoc" driver_tool.builds)
38
+
"/home/opam/doc-tools/bin/sherlodoc" ]
39
+
40
+
(** Pre-mount prep for doc containers: create /home/opam/odoc-out and
41
+
/home/opam/html mount points, chown to build user. *)
42
+
let doc_prep_upper env ~uid ~gid ~upper ~lowers:_ =
43
+
let mkdir path = Bos.OS.Dir.create ~path:true path |> ignore in
44
+
let odoc_out = Fpath.(upper / "home" / "opam" / "odoc-out") in
45
+
let html = Fpath.(upper / "home" / "opam" / "html") in
46
+
mkdir odoc_out; mkdir html;
47
+
ignore (Day11_exec.Sudo.run env
48
+
Bos.Cmd.(v "chown" % Printf.sprintf "%d:%d" uid gid
49
+
% Fpath.to_string odoc_out % Fpath.to_string html))
50
+
51
+
let doc_cleanup _env upper =
52
+
ignore (Day11_exec.Sudo.rm_rf _env
53
+
Fpath.(upper / "home" / "opam" / "doc-tools"))
54
+
55
+
(** Set up the prep structure and mounts for a doc container.
56
+
Returns (universe, mounts, prep_dir) or None if the package
57
+
has no documentable libs. Caller must clean up prep_dir. *)
58
+
let prepare ~(config : doc_config) ~build_layer pkg =
59
+
let installed_libs = Installed_files.scan_libs ~layer_dir:build_layer in
60
+
if installed_libs = [] then None
61
+
else
62
+
let installed_docs = Installed_files.scan_docs ~layer_dir:build_layer in
63
+
let universe = Command.compute_universe_hash
64
+
[ Fpath.basename build_layer ] in
65
+
let tool_mounts = make_tool_mounts ~os_dir:config.os_dir
66
+
~driver_tool:config.driver_tool ~odoc_tool:config.odoc_tool in
67
+
let prep_dir = Bos.OS.Dir.tmp "day11_doc_%s" |> Result.get_ok in
68
+
match Prep.create_with_mounts ~source_layer_dir:build_layer
69
+
~dest_layer_dir:prep_dir ~universe ~pkg
70
+
~installed_libs ~installed_docs with
71
+
| Ok (_prep_root, lib_mounts) ->
72
+
let prep_mount = Day11_container.Mount.bind_ro
73
+
~src:(Fpath.to_string Fpath.(prep_dir / "prep"))
74
+
"/home/opam/prep" in
75
+
let mounts = tool_mounts @ [ prep_mount ] @ lib_mounts in
76
+
Some (universe, mounts, prep_dir)
77
+
| Error _ -> None
78
+
79
+
let compile env benv ~(config : doc_config) ~build_layer
80
+
~dep_compile_layers ~hash pkg =
81
+
match prepare ~config ~build_layer pkg with
82
+
| None -> Error "no documentable libraries"
83
+
| Some (universe, mounts, prep_dir) ->
84
+
let blessed = config.blessed in
85
+
let cmd =
86
+
"export PATH=/home/opam/doc-tools/bin:$PATH && eval $(opam env) && " ^
87
+
Command.odoc_driver_voodoo ~pkg ~universe
88
+
~blessed ~actions:"compile-only" ~odoc_bin ~odoc_md_bin in
89
+
let compile_node : Build.t =
90
+
{ hash; pkg; deps = [];
91
+
universe = Day11_solution.Universe.dummy } in
92
+
let dep_hashes = List.map (fun d ->
93
+
Fpath.basename d) dep_compile_layers in
94
+
let on_extract ~layer_dir ~success:_ =
95
+
let dm : Doc_meta.t = {
96
+
package = OpamPackage.to_string pkg;
97
+
phase = Doc_meta.Compile;
98
+
deps = dep_hashes;
99
+
} in
100
+
ignore (Doc_meta.save layer_dir dm)
101
+
in
102
+
let result =
103
+
match Day11_opam_build.Build_layer.build env benv
104
+
~mounts ~build_dirs:dep_compile_layers
105
+
~prep_upper:(doc_prep_upper env ~uid:benv.uid ~gid:benv.gid)
106
+
~on_extract compile_node
107
+
~strategy:{ cmd; cleanup = doc_cleanup } () with
108
+
| Day11_opam_build.Types.Success _bl ->
109
+
Ok (Day11_opam_layer.Build.dir ~os_dir:config.os_dir compile_node)
110
+
| _ ->
111
+
Error (Printf.sprintf "compile failed for %s"
112
+
(OpamPackage.to_string pkg))
113
+
in
114
+
ignore (Day11_exec.Sudo.rm_rf env prep_dir);
115
+
result
116
+
117
+
let link env benv ~(config : doc_config) ~build_layer
118
+
~compile_layer ~dep_compile_layers ~html_dir ~hash pkg =
119
+
match prepare ~config ~build_layer pkg with
120
+
| None -> Error "no documentable libraries"
121
+
| Some (universe, mounts, prep_dir) ->
122
+
let blessed = config.blessed in
123
+
let all_compile_dirs = compile_layer :: dep_compile_layers in
124
+
let html_mount = Day11_container.Mount.bind_rw
125
+
~src:(Fpath.to_string html_dir)
126
+
Odoc_store.container_html in
127
+
let cmd =
128
+
"export PATH=/home/opam/doc-tools/bin:$PATH && eval $(opam env) && " ^
129
+
Command.odoc_driver_voodoo ~pkg ~universe
130
+
~blessed ~actions:"link-and-gen" ~odoc_bin ~odoc_md_bin in
131
+
let link_node : Build.t =
132
+
{ hash; pkg; deps = [];
133
+
universe = Day11_solution.Universe.dummy } in
134
+
let on_extract ~layer_dir ~success:_ =
135
+
let dm : Doc_meta.t = {
136
+
package = OpamPackage.to_string pkg;
137
+
phase = Doc_meta.Link;
138
+
deps = [];
139
+
} in
140
+
ignore (Doc_meta.save layer_dir dm)
141
+
in
142
+
let result =
143
+
match Day11_opam_build.Build_layer.build env benv
144
+
~mounts:(mounts @ [html_mount])
145
+
~build_dirs:all_compile_dirs
146
+
~prep_upper:(doc_prep_upper env ~uid:benv.uid ~gid:benv.gid)
147
+
~on_extract link_node
148
+
~strategy:{ cmd; cleanup = doc_cleanup } () with
149
+
| Day11_opam_build.Types.Success _ -> Ok ()
150
+
| _ ->
151
+
Error (Printf.sprintf "link failed for %s"
152
+
(OpamPackage.to_string pkg))
153
+
in
154
+
ignore (Day11_exec.Sudo.rm_rf env prep_dir);
155
+
result
156
+
157
+
let doc_all env benv ~(config : doc_config) ~build_layer
158
+
~dep_compile_layers ~html_dir ~hash pkg =
159
+
match prepare ~config ~build_layer pkg with
160
+
| None -> Error "no documentable libraries"
161
+
| Some (universe, mounts, prep_dir) ->
162
+
let blessed = config.blessed in
163
+
let html_mount = Day11_container.Mount.bind_rw
164
+
~src:(Fpath.to_string html_dir)
165
+
Odoc_store.container_html in
166
+
let cmd =
167
+
"export PATH=/home/opam/doc-tools/bin:$PATH && eval $(opam env) && " ^
168
+
Command.odoc_driver_voodoo ~pkg ~universe
169
+
~blessed ~actions:"all" ~odoc_bin ~odoc_md_bin in
170
+
let doc_node : Build.t =
171
+
{ hash; pkg; deps = [];
172
+
universe = Day11_solution.Universe.dummy } in
173
+
let dep_hashes = List.map (fun d ->
174
+
Fpath.basename d) dep_compile_layers in
175
+
let on_extract ~layer_dir ~success:_ =
176
+
let dm : Doc_meta.t = {
177
+
package = OpamPackage.to_string pkg;
178
+
phase = Doc_meta.Doc_all;
179
+
deps = dep_hashes;
180
+
} in
181
+
ignore (Doc_meta.save layer_dir dm)
182
+
in
183
+
let result =
184
+
match Day11_opam_build.Build_layer.build env benv
185
+
~mounts:(mounts @ [html_mount])
186
+
~build_dirs:dep_compile_layers
187
+
~prep_upper:(doc_prep_upper env ~uid:benv.uid ~gid:benv.gid)
188
+
~on_extract doc_node
189
+
~strategy:{ cmd; cleanup = doc_cleanup } () with
190
+
| Day11_opam_build.Types.Success _bl ->
191
+
Ok (Day11_opam_layer.Build.dir ~os_dir:config.os_dir doc_node)
192
+
| _ ->
193
+
Error (Printf.sprintf "doc-all failed for %s"
194
+
(OpamPackage.to_string pkg))
195
+
in
196
+
ignore (Day11_exec.Sudo.rm_rf env prep_dir);
197
+
result
198
+
199
+
let validate_cached_doc ~os_dir layer_dir =
200
+
let doc_json = Fpath.(layer_dir / "doc.json") in
201
+
match Doc_meta.load doc_json with
202
+
| Error _ -> true (* no doc.json = old format, assume OK *)
203
+
| Ok dm ->
204
+
List.for_all (fun dep_name ->
205
+
let dep_dir = Fpath.(os_dir / dep_name) in
206
+
Day11_layer.Layer.is_ok { hash = dep_name; dir = dep_dir }
207
+
) dm.deps
+86
doc/doc_build.mli
+86
doc/doc_build.mli
···
1
+
(** Stateless per-package doc build primitives.
2
+
3
+
Each function takes explicit inputs (layer directories, tool
4
+
directories, package metadata) and produces a result. No shared
5
+
mutable state, no DAG knowledge, no hashtable lookups. These are
6
+
the building blocks for both the DAG-based batch executor and
7
+
potential integration with external pipeline systems like OCurrent.
8
+
9
+
All functions follow the same pattern:
10
+
- Check preconditions (installed libs, tool availability)
11
+
- Set up container mounts and prep structure
12
+
- Run odoc_driver_voodoo in a container via Build_layer.build
13
+
- Return the resulting layer directory or None on failure *)
14
+
15
+
type doc_config = {
16
+
driver_tool : Day11_opam_layer.Tool.t;
17
+
odoc_tool : Day11_opam_layer.Tool.t;
18
+
os_dir : Fpath.t;
19
+
blessed : bool;
20
+
}
21
+
(** Static configuration for a doc build. The tools and blessed status
22
+
are determined before execution and don't change across packages
23
+
within the same compiler universe. *)
24
+
25
+
val compile :
26
+
Eio_unix.Stdenv.base ->
27
+
Day11_opam_build.Types.build_env ->
28
+
config:doc_config ->
29
+
build_layer:Fpath.t ->
30
+
dep_compile_layers:Fpath.t list ->
31
+
hash:string ->
32
+
OpamPackage.t ->
33
+
(Fpath.t, string) result
34
+
(** [compile env benv ~config ~build_layer ~dep_compile_layers ~hash pkg]
35
+
runs the odoc compile phase for [pkg]. Reads source [.cmti] files from
36
+
[build_layer], stacks [dep_compile_layers] for cross-reference
37
+
resolution, and produces a compile layer at [os_dir/<hash>/].
38
+
39
+
Returns [Ok layer_dir] on success, [Error msg] on failure. *)
40
+
41
+
val link :
42
+
Eio_unix.Stdenv.base ->
43
+
Day11_opam_build.Types.build_env ->
44
+
config:doc_config ->
45
+
build_layer:Fpath.t ->
46
+
compile_layer:Fpath.t ->
47
+
dep_compile_layers:Fpath.t list ->
48
+
html_dir:Fpath.t ->
49
+
hash:string ->
50
+
OpamPackage.t ->
51
+
(unit, string) result
52
+
(** [link env benv ~config ~build_layer ~compile_layer
53
+
~dep_compile_layers ~html_dir ~hash pkg] runs the odoc link phase
54
+
for [pkg]. Reads [.odoc] files from [compile_layer] and
55
+
[dep_compile_layers], writes HTML to [html_dir].
56
+
57
+
Returns [Ok ()] on success. The link layer itself is ephemeral —
58
+
only the HTML output matters. *)
59
+
60
+
val doc_all :
61
+
Eio_unix.Stdenv.base ->
62
+
Day11_opam_build.Types.build_env ->
63
+
config:doc_config ->
64
+
build_layer:Fpath.t ->
65
+
dep_compile_layers:Fpath.t list ->
66
+
html_dir:Fpath.t ->
67
+
hash:string ->
68
+
OpamPackage.t ->
69
+
(Fpath.t, string) result
70
+
(** [doc_all env benv ~config ~build_layer ~dep_compile_layers
71
+
~html_dir ~hash pkg] runs compile + link + HTML generation in a
72
+
single container invocation. Returns the compile layer directory
73
+
(which contains the [.odoc] output for use by dependents). *)
74
+
75
+
val has_documentable_libs :
76
+
Fpath.t -> bool
77
+
(** [has_documentable_libs layer_dir] returns true if the build layer
78
+
has installed libraries that can be documented. *)
79
+
80
+
val validate_cached_doc :
81
+
os_dir:Fpath.t -> Fpath.t -> bool
82
+
(** [validate_cached_doc ~os_dir layer_dir] checks that a cached doc
83
+
layer's dep compile layers (recorded in doc.json) are all present
84
+
on disk. Returns [false] if any deps are missing, meaning the
85
+
cached layer was built with incomplete inputs and should be
86
+
invalidated. *)
+381
-522
doc/generate.ml
+381
-522
doc/generate.ml
···
1
-
open Day11_opam_layer
2
1
module Build = Day11_opam_layer.Build
3
2
module Tool = Day11_opam_layer.Tool
4
-
(* Doc_meta is now part of this library *)
3
+
module Installed_files = Day11_opam_layer.Installed_files
5
4
6
-
(* Local aliases so the existing code reads naturally. *)
7
5
type build = Build.t
8
-
type tool = Tool.t
9
6
10
7
let concrete_compiler_names = List.map OpamPackage.Name.of_string
11
8
[ "ocaml-base-compiler"; "ocaml-variants"; "ocaml-system" ]
···
21
18
else None
22
19
) solution None
23
20
24
-
let extract_bin ~os_dir tool_builds name =
25
-
let switch = Day11_opam_build.Types.switch in
26
-
List.find_map (fun (bl : build) ->
27
-
let bin = Fpath.(Build.dir ~os_dir bl / "fs" / "home" / "opam"
28
-
/ ".opam" / switch / "bin" / name) in
29
-
if Bos.OS.File.exists bin |> Result.get_ok then Some bin
30
-
else None
31
-
) tool_builds
32
-
33
-
let make_doc_mounts ~os_dir ~(driver_tool : tool) ~(odoc_tool : tool) =
34
-
let find name builds =
35
-
match extract_bin ~os_dir builds name with
36
-
| Some p -> p
37
-
| None -> failwith (Printf.sprintf "Doc tool binary %s not found" name)
38
-
in
39
-
let mount src dst = Day11_container.Mount.bind_ro
40
-
~src:(Fpath.to_string src) dst in
41
-
[ mount (find "odoc" odoc_tool.builds) "/home/opam/doc-tools/bin/odoc";
42
-
mount (find "odoc-md" driver_tool.builds) "/home/opam/doc-tools/bin/odoc-md";
43
-
mount (find "odoc_driver_voodoo" driver_tool.builds)
44
-
"/home/opam/doc-tools/bin/odoc_driver_voodoo";
45
-
mount (find "sherlodoc" driver_tool.builds)
46
-
"/home/opam/doc-tools/bin/sherlodoc" ]
47
-
48
-
let doc_cleanup _env upper =
49
-
ignore (Day11_exec.Sudo.rm_rf _env
50
-
Fpath.(upper / "home" / "opam" / "doc-tools"))
51
-
52
-
(** Pre-mount prep for an odoc doc container. The container has
53
-
bind mounts at [/home/opam/odoc-out] and [/home/opam/html] for
54
-
its output, and runc requires those mount points to exist
55
-
inside the merged rootfs. We mkdir them in the upper before
56
-
mounting and chown them to the build user. No opam switch-state
57
-
is needed — doc containers don't run [opam install]. *)
58
-
let doc_prep_upper env ~uid ~gid ~upper ~lowers:_ =
59
-
let mkdir path = Bos.OS.Dir.create ~path:true path |> ignore in
60
-
let odoc_out = Fpath.(upper / "home" / "opam" / "odoc-out") in
61
-
let html = Fpath.(upper / "home" / "opam" / "html") in
62
-
mkdir odoc_out; mkdir html;
63
-
ignore (Day11_exec.Sudo.run env
64
-
Bos.Cmd.(v "chown" % Printf.sprintf "%d:%d" uid gid
65
-
% Fpath.to_string odoc_out % Fpath.to_string html))
66
-
67
-
let odoc_bin = "/home/opam/doc-tools/bin/odoc"
68
-
let odoc_md_bin = "/home/opam/doc-tools/bin/odoc-md"
69
-
70
21
(** Collect transitive build dep hashes into a seen set. *)
71
22
let collect_transitive_deps (seen : (string, unit) Hashtbl.t)
72
23
(node : Build.t) =
···
78
29
in
79
30
walk node
80
31
32
+
(* Stateless wrappers that delegate to Doc_build primitives.
33
+
All state (which compile layers exist, dep relationships) is
34
+
derived from the DAG structure and disk. *)
81
35
82
-
(** Prepare mounts and metadata for a doc container.
83
-
Returns None if the package has no installed libs or no matching
84
-
odoc tool. Caller must clean up [prep_dir] after use. *)
85
-
let prepare_package ~os_dir ~(driver_tool : Tool.t) ~odoc_tools:_ ~build_hash_blessed
86
-
~find_odoc_tool (node : build) =
87
-
let pkg_dir = Build.dir ~os_dir node in
88
-
let installed_libs = Installed_files.scan_libs
89
-
~layer_dir:pkg_dir in
90
-
if installed_libs = [] then None
91
-
else match find_odoc_tool node.pkg with
92
-
| None -> None
93
-
| Some (odoc_tool : Tool.t) ->
94
-
let installed_docs = Installed_files.scan_docs
95
-
~layer_dir:pkg_dir in
96
-
let composite_tool_hash = Day11_layer.Hash.of_strings
97
-
[ driver_tool.hash; odoc_tool.hash ] in
98
-
let universe = Command.compute_universe_hash [ node.hash ] in
99
-
let doc_mounts = make_doc_mounts ~os_dir ~driver_tool ~odoc_tool in
100
-
let blessed = match Hashtbl.find_opt build_hash_blessed node.hash with
101
-
| Some true -> true
102
-
| _ -> false in
103
-
let prep_dir = Bos.OS.Dir.tmp "day11_doc_%s" |> Result.get_ok in
104
-
(match Prep.create_with_mounts ~source_layer_dir:pkg_dir
105
-
~dest_layer_dir:prep_dir ~universe ~pkg:node.pkg
106
-
~installed_libs ~installed_docs with
107
-
| Ok (_prep_root, lib_mounts) ->
108
-
let prep_mount = Day11_container.Mount.bind_ro
109
-
~src:(Fpath.to_string Fpath.(prep_dir / "prep"))
110
-
"/home/opam/prep" in
111
-
let pkg_loc : Odoc_store.pkg_loc =
112
-
{ pkg = node.pkg; universe; blessed } in
113
-
let mounts = doc_mounts @ [ prep_mount ] @ lib_mounts in
114
-
Some (composite_tool_hash, universe, blessed, pkg_loc, mounts, prep_dir)
115
-
| Error _ -> None)
36
+
module Layer = Day11_layer.Layer
116
37
117
-
let compile_package env benv ~os_dir ~driver_tool ~odoc_tools
118
-
~build_hash_blessed ~find_odoc_tool ~compile_results (node : build) =
119
-
match prepare_package ~os_dir ~driver_tool ~odoc_tools
120
-
~build_hash_blessed ~find_odoc_tool node with
121
-
| None -> None
122
-
| Some (composite_tool_hash, universe, blessed, _pkg_loc, mounts, prep_dir) ->
123
-
(* Collect dep compile layers for overlayfs stacking *)
124
-
let seen = Hashtbl.create 16 in
125
-
List.iter (collect_transitive_deps seen) node.deps;
126
-
let dep_compile_layers = Hashtbl.fold (fun bh () acc ->
127
-
match Hashtbl.find_opt compile_results bh with
128
-
| Some bl -> bl :: acc
129
-
| None -> acc
130
-
) seen [] in
131
-
let dep_compile_dirs = List.map (Build.dir ~os_dir) dep_compile_layers in
132
-
let dep_compile_hashes = List.map (fun (bl : build) -> bl.hash)
133
-
dep_compile_layers in
134
-
let cmd =
135
-
"export PATH=/home/opam/doc-tools/bin:$PATH && eval $(opam env) && " ^
136
-
Command.odoc_driver_voodoo ~pkg:node.pkg ~universe
137
-
~blessed ~actions:"compile-only" ~odoc_bin ~odoc_md_bin in
138
-
let hash = Day11_layer.Hash.of_strings
139
-
([ "compile"; node.hash; composite_tool_hash;
140
-
(if blessed then "blessed" else "unblessed") ]
141
-
@ dep_compile_hashes) in
142
-
let compile_node : build =
143
-
{ hash; pkg = node.pkg; deps = [ node ]; universe = Day11_solution.Universe.dummy } in
144
-
let on_extract ~layer_dir ~success:_ =
145
-
let dm : Doc_meta.t = {
146
-
package = OpamPackage.to_string node.pkg;
147
-
phase = Doc_meta.Compile;
148
-
deps = List.map (fun (d : build) -> OpamPackage.to_string d.pkg) compile_node.deps;
149
-
} in
150
-
ignore (Doc_meta.save layer_dir dm)
151
-
in
152
-
let result =
153
-
match Day11_opam_build.Build_layer.build env benv
154
-
~mounts ~build_dirs:dep_compile_dirs
155
-
~prep_upper:(doc_prep_upper env ~uid:benv.uid ~gid:benv.gid)
156
-
~on_extract
157
-
compile_node
158
-
~strategy:{ cmd; cleanup = doc_cleanup } () with
159
-
| Day11_opam_build.Types.Success bl ->
160
-
Hashtbl.replace compile_results node.hash bl;
161
-
Some bl
162
-
| _ ->
163
-
Printf.printf " %s: compile FAILED\n%!"
164
-
(OpamPackage.to_string node.pkg);
165
-
None
166
-
in
167
-
ignore (Day11_exec.Sudo.rm_rf env prep_dir);
168
-
result
38
+
(** Find dep compile layer dirs by looking up each transitive build
39
+
dep's compile/doc-all hash from the precomputed mapping.
40
+
Includes only deps whose compile layers exist and succeeded on disk.
41
+
Deps with no doc node (no documentable libs) are silently skipped. *)
42
+
let find_dep_compile_layers ~os_dir ~build_to_doc_hash (node : build) =
43
+
let seen = Hashtbl.create 16 in
44
+
List.iter (collect_transitive_deps seen) node.deps;
45
+
Hashtbl.fold (fun dep_bh () acc ->
46
+
match Hashtbl.find_opt build_to_doc_hash dep_bh with
47
+
| Some doc_hash ->
48
+
let layer = Layer.of_hash ~os_dir doc_hash in
49
+
if Layer.is_ok layer then Layer.dir layer :: acc
50
+
else acc
51
+
| None -> acc
52
+
) seen []
53
+
54
+
let compile_package env benv ~os_dir ~odoc_tool ~build_hash_blessed
55
+
~driver_tool ~build_to_doc_hash ~dag_hash (node : build) =
56
+
let blessed = match Hashtbl.find_opt build_hash_blessed node.hash with
57
+
| Some true -> true | _ -> false in
58
+
match odoc_tool with
59
+
| None -> false
60
+
| Some (odoc_tool : Tool.t) ->
61
+
let config : Doc_build.doc_config =
62
+
{ driver_tool; odoc_tool; os_dir; blessed } in
63
+
let build_layer = Build.dir ~os_dir node in
64
+
let dep_compile_layers =
65
+
find_dep_compile_layers ~os_dir ~build_to_doc_hash node in
66
+
match Doc_build.compile env benv ~config ~build_layer
67
+
~dep_compile_layers ~hash:dag_hash node.pkg with
68
+
| Ok _ -> true
69
+
| Error msg ->
70
+
Printf.printf " %s: compile FAILED (%s)\n%!"
71
+
(OpamPackage.to_string node.pkg) msg;
72
+
false
169
73
170
-
let link_package env benv ~os_dir ~driver_tool ~odoc_tools
171
-
~build_hash_blessed ~find_odoc_tool ~compile_results
172
-
~doc_dep_hashes
173
-
~build_hash
174
-
(node : build) =
175
-
match Hashtbl.find_opt compile_results build_hash with
176
-
| None -> None
177
-
| Some compile_bl ->
178
-
match prepare_package ~os_dir ~driver_tool ~odoc_tools
179
-
~build_hash_blessed ~find_odoc_tool node with
180
-
| None -> None
181
-
| Some (composite_tool_hash, universe, blessed, _pkg_loc, mounts, prep_dir) ->
182
-
(* Collect compile layers from doc_deps (wider set, includes {post}
183
-
and x-extra-doc-deps for cross-referencing) *)
74
+
let link_package env benv ~os_dir ~odoc_tool ~build_hash_blessed
75
+
~driver_tool ~build_to_doc_hash ~doc_dep_hashes
76
+
~build_hash ~compile_hash ~dag_hash (node : build) =
77
+
let blessed = match Hashtbl.find_opt build_hash_blessed node.hash with
78
+
| Some true -> true | _ -> false in
79
+
let compile_layer = Layer.of_hash ~os_dir compile_hash in
80
+
if not (Layer.is_ok compile_layer) then false
81
+
else
82
+
match odoc_tool with
83
+
| None -> false
84
+
| Some (odoc_tool : Tool.t) ->
85
+
let config : Doc_build.doc_config =
86
+
{ driver_tool; odoc_tool; os_dir; blessed } in
87
+
let build_layer = Build.dir ~os_dir node in
88
+
let compile_layer = Layer.dir compile_layer in
184
89
let doc_dep_bhs = match Hashtbl.find_opt doc_dep_hashes build_hash with
185
90
| Some bhs -> bhs | None -> [] in
186
91
let dep_compile_layers = List.filter_map (fun bh ->
187
-
Hashtbl.find_opt compile_results bh
92
+
match Hashtbl.find_opt build_to_doc_hash bh with
93
+
| Some doc_hash ->
94
+
let l = Layer.of_hash ~os_dir doc_hash in
95
+
if Layer.is_ok l then Some (Layer.dir l)
96
+
else None
97
+
| _ -> None
188
98
) doc_dep_bhs in
189
-
let dep_compile_dirs = List.map (Build.dir ~os_dir) dep_compile_layers in
190
-
let dep_hashes = List.map (fun (bl : build) -> bl.hash)
191
-
dep_compile_layers in
192
-
(* Also include own compile layer *)
193
-
let own_compile_dir = match Hashtbl.find_opt compile_results build_hash with
194
-
| Some bl -> [ Build.dir ~os_dir bl ]
195
-
| None -> [] in
196
-
let all_compile_dirs = own_compile_dir @ dep_compile_dirs in
197
-
(* HTML RW mount — entire html dir *)
198
-
let html_base = Fpath.(os_dir / "html") in
199
-
let html_mount = Day11_container.Mount.bind_rw
200
-
~src:(Fpath.to_string html_base)
201
-
Odoc_store.container_html in
202
-
let cmd =
203
-
"export PATH=/home/opam/doc-tools/bin:$PATH && eval $(opam env) && " ^
204
-
Command.odoc_driver_voodoo ~pkg:node.pkg ~universe
205
-
~blessed ~actions:"link-and-gen" ~odoc_bin ~odoc_md_bin in
206
-
let hash = Day11_layer.Hash.of_strings
207
-
([ "link"; compile_bl.hash; universe; composite_tool_hash;
208
-
(if blessed then "blessed" else "unblessed") ]
209
-
@ dep_hashes) in
210
-
let link_node : build =
211
-
{ hash; pkg = node.pkg;
212
-
deps = [ node; compile_bl ] @ dep_compile_layers; universe = Day11_solution.Universe.dummy } in
213
-
let on_extract ~layer_dir ~success:_ =
214
-
let dm : Doc_meta.t = {
215
-
package = OpamPackage.to_string node.pkg;
216
-
phase = Doc_meta.Link;
217
-
deps = List.map (fun (d : build) -> OpamPackage.to_string d.pkg) link_node.deps;
218
-
} in
219
-
ignore (Doc_meta.save layer_dir dm)
220
-
in
221
-
let result =
222
-
match Day11_opam_build.Build_layer.build env benv
223
-
~mounts:(mounts @ [html_mount]) ~build_dirs:all_compile_dirs
224
-
~prep_upper:(doc_prep_upper env ~uid:benv.uid ~gid:benv.gid)
225
-
~on_extract
226
-
link_node
227
-
~strategy:{ cmd; cleanup = doc_cleanup } () with
228
-
| Day11_opam_build.Types.Success _bl ->
229
-
Printf.printf " %s: linked\n%!"
230
-
(OpamPackage.to_string node.pkg);
231
-
Some 0
232
-
| _ ->
233
-
Printf.printf " %s: link FAILED\n%!"
234
-
(OpamPackage.to_string node.pkg);
235
-
None
236
-
in
237
-
ignore (Day11_exec.Sudo.rm_rf env prep_dir);
238
-
result
99
+
let html_dir = Fpath.(os_dir / "html") in
100
+
match Doc_build.link env benv ~config ~build_layer ~compile_layer
101
+
~dep_compile_layers ~html_dir ~hash:dag_hash node.pkg with
102
+
| Ok () -> true
103
+
| Error msg ->
104
+
Printf.printf " %s: link FAILED (%s)\n%!"
105
+
(OpamPackage.to_string node.pkg) msg;
106
+
false
239
107
240
-
let doc_all_package env benv ~os_dir ~driver_tool ~odoc_tools
241
-
~build_hash_blessed ~find_odoc_tool ~compile_results
242
-
~build_hash
243
-
(node : build) =
244
-
match prepare_package ~os_dir ~driver_tool ~odoc_tools
245
-
~build_hash_blessed ~find_odoc_tool node with
246
-
| None -> None
247
-
| Some (composite_tool_hash, universe, blessed, _pkg_loc, mounts, prep_dir) ->
248
-
(* Collect dep compile layers for overlayfs stacking + hash *)
249
-
let seen = Hashtbl.create 16 in
250
-
List.iter (collect_transitive_deps seen) node.deps;
251
-
let dep_compile_layers = Hashtbl.fold (fun bh () acc ->
252
-
match Hashtbl.find_opt compile_results bh with
253
-
| Some bl -> bl :: acc
254
-
| None -> acc
255
-
) seen [] in
256
-
let dep_compile_dirs = List.map (Build.dir ~os_dir) dep_compile_layers in
257
-
let dep_compile_hashes = List.map (fun (bl : build) -> bl.hash)
258
-
dep_compile_layers in
259
-
(* HTML RW mount — mount entire html dir so global assets (css, js)
260
-
and per-package output both land in the shared dir *)
261
-
let html_base = Fpath.(os_dir / "html") in
262
-
let html_mount = Day11_container.Mount.bind_rw
263
-
~src:(Fpath.to_string html_base)
264
-
Odoc_store.container_html in
265
-
let cmd =
266
-
"export PATH=/home/opam/doc-tools/bin:$PATH && eval $(opam env) && " ^
267
-
Command.odoc_driver_voodoo ~pkg:node.pkg ~universe
268
-
~blessed ~actions:"all" ~odoc_bin ~odoc_md_bin in
269
-
let hash = Day11_layer.Hash.of_strings
270
-
([ "doc-all"; node.hash; universe; composite_tool_hash;
271
-
(if blessed then "blessed" else "unblessed") ]
272
-
@ dep_compile_hashes) in
273
-
let doc_node : build =
274
-
{ hash; pkg = node.pkg;
275
-
deps = [ node ] @ dep_compile_layers; universe = Day11_solution.Universe.dummy } in
276
-
let on_extract ~layer_dir ~success:_ =
277
-
let dm : Doc_meta.t = {
278
-
package = OpamPackage.to_string node.pkg;
279
-
phase = Doc_meta.Doc_all;
280
-
deps = List.map (fun (d : build) -> OpamPackage.to_string d.pkg) doc_node.deps;
281
-
} in
282
-
ignore (Doc_meta.save layer_dir dm)
283
-
in
284
-
let result =
285
-
match Day11_opam_build.Build_layer.build env benv
286
-
~mounts:(mounts @ [html_mount]) ~build_dirs:dep_compile_dirs
287
-
~prep_upper:(doc_prep_upper env ~uid:benv.uid ~gid:benv.gid)
288
-
~on_extract
289
-
doc_node
290
-
~strategy:{ cmd; cleanup = doc_cleanup } () with
291
-
| Day11_opam_build.Types.Success bl ->
292
-
Hashtbl.replace compile_results build_hash bl;
293
-
Printf.printf " %s: doc-all OK\n%!"
294
-
(OpamPackage.to_string node.pkg);
295
-
Some 0
296
-
| _ ->
297
-
Printf.printf " %s: doc-all FAILED\n%!"
298
-
(OpamPackage.to_string node.pkg);
299
-
None
300
-
in
301
-
ignore (Day11_exec.Sudo.rm_rf env prep_dir);
302
-
result
108
+
let doc_all_package env benv ~os_dir ~odoc_tool ~build_hash_blessed
109
+
~driver_tool ~build_to_doc_hash ~dag_hash (node : build) =
110
+
let blessed = match Hashtbl.find_opt build_hash_blessed node.hash with
111
+
| Some true -> true | _ -> false in
112
+
match odoc_tool with
113
+
| None -> false
114
+
| Some (odoc_tool : Tool.t) ->
115
+
let config : Doc_build.doc_config =
116
+
{ driver_tool; odoc_tool; os_dir; blessed } in
117
+
let build_layer = Build.dir ~os_dir node in
118
+
let dep_compile_layers =
119
+
find_dep_compile_layers ~os_dir ~build_to_doc_hash node in
120
+
let html_dir = Fpath.(os_dir / "html") in
121
+
match Doc_build.doc_all env benv ~config ~build_layer
122
+
~dep_compile_layers ~html_dir ~hash:dag_hash node.pkg with
123
+
| Ok _ -> true
124
+
| Error msg ->
125
+
Printf.printf " %s: doc-all FAILED (%s)\n%!"
126
+
(OpamPackage.to_string node.pkg) msg;
127
+
false
303
128
304
-
let run env benv ~np ~os_dir ~(driver_tool : Tool.t) ~odoc_tools
305
-
~tool_source_dirs ~mounts
306
-
~run_log
307
-
~build_one ~nodes ~solutions ~blessing_maps:_ =
308
-
(* Ensure HTML output directory exists *)
129
+
(* ── Internal: shared DAG construction ───────────────────────── *)
130
+
131
+
(** Internal plan tables produced by [build_internal_plan].
132
+
Contains all immutable mappings needed for dispatch. *)
133
+
type internal_plan = {
134
+
all_nodes : build list;
135
+
build_by_hash : (string, build) Hashtbl.t;
136
+
build_to_doc_hash : (string, string) Hashtbl.t;
137
+
build_hash_blessed : (string, bool) Hashtbl.t;
138
+
doc_dep_hashes : (string, string list) Hashtbl.t;
139
+
compile_to_build : (string, string) Hashtbl.t;
140
+
doc_all_to_build : (string, string) Hashtbl.t;
141
+
link_to_build : (string, string) Hashtbl.t;
142
+
compile_set : (string, unit) Hashtbl.t;
143
+
doc_all_set : (string, unit) Hashtbl.t;
144
+
link_set : (string, unit) Hashtbl.t;
145
+
tool_node_set : (string, unit) Hashtbl.t;
146
+
find_odoc_tool_for_hash : string -> Tool.t option;
147
+
driver_tool : Tool.t;
148
+
}
149
+
150
+
(** Build the doc DAG: compute compile/link/doc-all nodes with
151
+
deterministic hashes, derive all dispatch tables. Pure function
152
+
of the inputs — no mutable state escapes. *)
153
+
let build_internal_plan ~os_dir ~(driver_tool : Tool.t) ~odoc_tools
154
+
~nodes ~solutions =
309
155
ignore (Bos.OS.Dir.create ~path:true Fpath.(os_dir / "html"));
310
-
(* Collect all tool nodes for inclusion in the unified DAG *)
156
+
(* Collect tool nodes *)
311
157
let tool_nodes =
312
158
let seen = Hashtbl.create 64 in
313
159
let add_nodes builds =
···
320
166
List.iter (fun (_, (tool : Tool.t)) -> add_nodes tool.builds) odoc_tools;
321
167
Hashtbl.fold (fun _ n acc -> n :: acc) seen []
322
168
in
323
-
(* Find the final build node for each tool *)
324
169
let driver_final = List.find (fun (n : build) ->
325
170
String.equal n.hash driver_tool.hash) driver_tool.builds in
326
171
let odoc_finals = List.map (fun (compiler, (tool : Tool.t)) ->
···
328
173
String.equal n.hash tool.hash) tool.builds in
329
174
(compiler, tool, final)
330
175
) odoc_tools in
331
-
(* Derive compiler per build node. First pass: walk DAG deps to find
332
-
the concrete compiler (ocaml-base-compiler/variants/system). *)
176
+
(* Derive compiler per build node *)
333
177
let node_compiler : (string, OpamPackage.t) Hashtbl.t =
334
178
Hashtbl.create (List.length nodes) in
335
179
let rec derive_compiler (node : build) =
···
350
194
result
351
195
in
352
196
List.iter (fun node -> ignore (derive_compiler node)) nodes;
353
-
(* find_odoc_tool: given a build node hash, return the matching odoc tool *)
197
+
List.iter (fun node -> ignore (derive_compiler node)) tool_nodes;
198
+
(* find_odoc_tool_for_hash: given a build node hash, return the matching odoc tool *)
354
199
let find_odoc_tool_for_hash build_hash =
355
200
match Hashtbl.find_opt node_compiler build_hash with
356
201
| None -> None
···
367
212
OpamPackage.equal c compiler) odoc_finals
368
213
|> Option.map (fun (_, _, final) -> final)
369
214
in
370
-
(* find_odoc_tool for prepare/compile/link: takes build_hash via thread-local ref.
371
-
Safe because Eio fibers are cooperatively scheduled — no preemption between
372
-
setting the ref and calling prepare_package. *)
373
-
let current_build_hash = ref "" in
374
-
let find_odoc_tool _pkg = find_odoc_tool_for_hash !current_build_hash in
375
-
(* Build hash -> build node index *)
215
+
(* Build indexes *)
216
+
(* Index ALL nodes (build + tool) by hash so find_dep_compile_layers
217
+
can locate dep compile layers for tool packages like ocaml-compiler
218
+
that aren't in the regular build DAG but have documentable libs. *)
376
219
let build_by_hash : (string, build) Hashtbl.t =
377
-
Hashtbl.create (List.length nodes) in
220
+
Hashtbl.create (List.length nodes + List.length tool_nodes) in
378
221
List.iter (fun (node : build) ->
379
-
Hashtbl.replace build_by_hash node.hash node
380
-
) nodes;
381
-
(* Per build hash: does it need separate compile+link?
382
-
Compare build_deps (no {post}) vs doc_deps (with {post} + x-extra-doc-deps). *)
222
+
Hashtbl.replace build_by_hash node.hash node) nodes;
223
+
List.iter (fun (node : build) ->
224
+
if not (Hashtbl.mem build_by_hash node.hash) then
225
+
Hashtbl.replace build_by_hash node.hash node) tool_nodes;
383
226
let needs_split : (string, bool) Hashtbl.t = Hashtbl.create 64 in
384
227
List.iter (fun (_target, (result : Day11_solution.Solve_result.t)) ->
385
228
let compiler = find_compiler result.build_deps in
···
391
234
Hashtbl.replace needs_split (pkg_s ^ ":" ^ compiler_s) true
392
235
) result.build_deps
393
236
) solutions;
394
-
(* Reverse index: pkg_string -> list of (build_hash, build) *)
395
237
let pkg_to_builds : (string, (string * build) list) Hashtbl.t =
396
238
Hashtbl.create (List.length nodes) in
397
239
Hashtbl.iter (fun bh (node : build) ->
···
400
242
with Not_found -> [] in
401
243
Hashtbl.replace pkg_to_builds pkg_s ((bh, node) :: existing)
402
244
) build_by_hash;
403
-
(* Build (pkg, compiler) -> build_hash index from solutions.
404
-
Each solution has one compiler; every package in it gets that compiler.
405
-
Also populate node_compiler for all build nodes. *)
406
245
let pkg_compiler_to_hash : (string * string, string) Hashtbl.t =
407
246
Hashtbl.create (List.length nodes) in
408
247
List.iter (fun (_target, (result : Day11_solution.Solve_result.t)) ->
···
417
256
| Some builds ->
418
257
List.iter (fun (bh, _node) ->
419
258
Hashtbl.replace pkg_compiler_to_hash (pkg_s, compiler_s) bh;
420
-
(* Only assign compiler to nodes that derive_compiler missed
421
-
(leaf nodes with no DAG deps like ocaml-compiler) *)
422
259
(match compiler with
423
260
| Some c when not (Hashtbl.mem node_compiler bh) ->
424
261
Hashtbl.replace node_compiler bh c
···
426
263
) builds
427
264
) solution
428
265
) solutions;
429
-
(* build_hash -> doc dep build hashes.
430
-
For the link phase, we need to mount odoc output from doc_deps
431
-
(which includes {post} deps and x-extra-doc-deps like odig),
432
-
not just the build DAG deps. *)
433
266
let doc_dep_hashes : (string, string list) Hashtbl.t = Hashtbl.create 64 in
434
267
List.iter (fun (_target, (result : Day11_solution.Solve_result.t)) ->
435
268
let compiler = find_compiler result.build_deps in
436
269
let compiler_s = match compiler with
437
270
| Some c -> OpamPackage.to_string c | None -> "" in
438
-
OpamPackage.Map.iter (fun pkg doc_deps_set ->
439
-
let pkg_s = OpamPackage.to_string pkg in
440
-
match Hashtbl.find_opt pkg_compiler_to_hash (pkg_s, compiler_s) with
441
-
| None -> ()
442
-
| Some pkg_bh ->
443
-
let dep_bhs = OpamPackage.Set.fold (fun dep_pkg acc ->
444
-
let dep_s = OpamPackage.to_string dep_pkg in
445
-
match Hashtbl.find_opt pkg_compiler_to_hash (dep_s, compiler_s) with
446
-
| Some bh when not (String.equal bh pkg_bh) -> bh :: acc
447
-
| _ -> acc
271
+
OpamPackage.Map.iter (fun _pkg doc_deps_set ->
272
+
let pkg_s = OpamPackage.to_string _pkg in
273
+
let pkg_bh = match Hashtbl.find_opt pkg_compiler_to_hash
274
+
(pkg_s, compiler_s) with
275
+
| Some bh -> bh | None -> "" in
276
+
if pkg_bh <> "" then
277
+
let dep_bhs = OpamPackage.Set.fold (fun dep acc ->
278
+
let dep_s = OpamPackage.to_string dep in
279
+
match Hashtbl.find_opt pkg_compiler_to_hash
280
+
(dep_s, compiler_s) with
281
+
| Some bh -> bh :: acc
282
+
| None -> acc
448
283
) doc_deps_set [] in
449
284
Hashtbl.replace doc_dep_hashes pkg_bh dep_bhs
450
285
) result.doc_deps
451
286
) solutions;
452
-
(* Resolve needs_split to build hashes *)
453
287
let needs_split_bh : (string, bool) Hashtbl.t = Hashtbl.create 64 in
454
288
Hashtbl.iter (fun key _ ->
455
289
match String.index_opt key ':' with
···
461
295
| Some bh -> Hashtbl.replace needs_split_bh bh true
462
296
| None -> ()
463
297
) needs_split;
464
-
(* Compute blessed per build hash. Each build node carries its
465
-
universe. Compare against the blessed universe for its package. *)
466
298
let blessed_universes = Day11_batch.Blessing.compute_blessed_universes
467
299
(List.map (fun (t, (r : Day11_solution.Solve_result.t)) ->
468
300
(t, r.build_deps)) solutions) in
···
474
306
Hashtbl.replace build_hash_blessed node.hash true
475
307
| _ -> ()
476
308
) nodes;
477
-
(* Build doc DAG nodes.
478
-
For packages that DON'T need separate link: "doc-all" node
479
-
depends on build(A), tool finals, and compile/doc-all of deps
480
-
For packages that DO need separate link: compile + link nodes
481
-
(compile produces .odoc files, link consumes them from other packages) *)
309
+
(* Build doc DAG nodes with deterministic hashes *)
482
310
let compile_nodes : (string, build) Hashtbl.t = Hashtbl.create 64 in
483
311
let doc_all_nodes : (string, build) Hashtbl.t = Hashtbl.create 64 in
484
312
let link_nodes_list = ref [] in
485
-
(* First pass: create compile or doc-all nodes *)
313
+
let compile_hash_cache : (string, string) Hashtbl.t = Hashtbl.create 64 in
314
+
let rec compute_compile_hash (node : build) =
315
+
match Hashtbl.find_opt compile_hash_cache node.hash with
316
+
| Some h -> h
317
+
| None ->
318
+
let blessed = match Hashtbl.find_opt build_hash_blessed node.hash with
319
+
| Some true -> true | _ -> false in
320
+
let composite_tool_hash = match find_odoc_tool_for_hash node.hash with
321
+
| Some odoc_tool ->
322
+
Day11_layer.Hash.of_strings [ driver_tool.hash; odoc_tool.hash ]
323
+
| None -> "" in
324
+
let seen = Hashtbl.create 16 in
325
+
List.iter (collect_transitive_deps seen) node.deps;
326
+
let dep_compile_hashes = Hashtbl.fold (fun dep_bh () acc ->
327
+
match Hashtbl.find_opt build_by_hash dep_bh with
328
+
| Some dep_node -> compute_compile_hash dep_node :: acc
329
+
| None -> acc
330
+
) seen [] in
331
+
let phase = if Hashtbl.mem needs_split_bh node.hash
332
+
then "compile" else "doc-all" in
333
+
let universe = Command.compute_universe_hash [ node.hash ] in
334
+
let hash = Day11_layer.Hash.of_strings
335
+
([ phase; node.hash; universe; composite_tool_hash;
336
+
(if blessed then "blessed" else "unblessed") ]
337
+
@ List.sort String.compare dep_compile_hashes) in
338
+
Hashtbl.replace compile_hash_cache node.hash hash;
339
+
hash
340
+
in
486
341
List.iter (fun (node : build) ->
342
+
let build_layer = Build.dir ~os_dir node in
343
+
if not (Doc_build.has_documentable_libs build_layer) then ()
344
+
else
487
345
match find_odoc_tool_for_hash node.hash,
488
346
find_odoc_final_for_hash node.hash with
489
347
| None, _ | _, None -> ()
490
-
| Some odoc_tool, Some odoc_final ->
491
-
let composite_tool_hash = Day11_layer.Hash.of_strings
492
-
[ driver_tool.hash; odoc_tool.hash ] in
493
-
if Hashtbl.mem needs_split_bh node.hash then begin
494
-
(* Needs separate compile phase *)
495
-
let compile_hash = Day11_layer.Hash.of_strings
496
-
[ "compile"; node.hash; composite_tool_hash ] in
497
-
let cn : build = { hash = compile_hash; pkg = node.pkg;
498
-
deps = [ node; driver_final; odoc_final ]; universe = Day11_solution.Universe.dummy } in
499
-
Hashtbl.replace compile_nodes node.hash cn
500
-
end else begin
501
-
(* Single doc-all phase — deps computed after universe is known *)
502
-
let universe = Command.compute_universe_hash [ node.hash ] in
503
-
let doc_all_hash = Day11_layer.Hash.of_strings
504
-
[ "doc-all"; node.hash; universe; composite_tool_hash ] in
505
-
let dn : build = { hash = doc_all_hash; pkg = node.pkg;
506
-
deps = [ node; driver_final; odoc_final ]; universe = Day11_solution.Universe.dummy } in
348
+
| Some _odoc_tool, Some odoc_final ->
349
+
let hash = compute_compile_hash node in
350
+
let dn : build = { hash; pkg = node.pkg;
351
+
deps = [ node; driver_final; odoc_final ];
352
+
universe = Day11_solution.Universe.dummy } in
353
+
if Hashtbl.mem needs_split_bh node.hash then
354
+
Hashtbl.replace compile_nodes node.hash dn
355
+
else
507
356
Hashtbl.replace doc_all_nodes node.hash dn
508
-
end
509
-
) nodes;
510
-
(* Patch deps: compile/doc-all nodes depend on their transitive
511
-
build deps' compile/doc-all nodes *)
357
+
) (nodes @ tool_nodes);
512
358
let patch_doc_deps build_hash (dn : build) =
513
359
let build_node = Hashtbl.find build_by_hash build_hash in
514
360
let seen = Hashtbl.create 16 in
···
517
363
match Hashtbl.find_opt compile_nodes dep_bh with
518
364
| Some cn -> cn :: acc
519
365
| None ->
520
-
match Hashtbl.find_opt doc_all_nodes dep_bh with
366
+
(match Hashtbl.find_opt doc_all_nodes dep_bh with
521
367
| Some dn -> dn :: acc
522
-
| None -> acc
368
+
| None -> acc)
523
369
) seen [] in
524
-
{ dn with deps = dn.deps @ dep_docs; universe = Day11_solution.Universe.dummy }
370
+
{ dn with deps = dn.deps @ dep_docs }
525
371
in
526
372
let compile_snapshot = Hashtbl.fold (fun k v acc -> (k, v) :: acc)
527
373
compile_nodes [] in
···
531
377
let doc_all_snapshot = Hashtbl.fold (fun k v acc -> (k, v) :: acc)
532
378
doc_all_nodes [] in
533
379
List.iter (fun (bh, dn) ->
534
-
(* Doc-all depends on transitive build deps' doc nodes. This follows
535
-
the package dependency DAG (acyclic), so no circular deps.
536
-
Ensures deps' odoc files are in the store before we link. *)
537
-
let patched = patch_doc_deps bh dn in
538
-
Hashtbl.replace doc_all_nodes bh patched
380
+
Hashtbl.replace doc_all_nodes bh (patch_doc_deps bh dn)
539
381
) doc_all_snapshot;
540
-
(* Create link nodes for packages that need separate link *)
541
382
Hashtbl.iter (fun build_hash _cn ->
542
383
let build_node = Hashtbl.find build_by_hash build_hash in
543
384
let dep_compile_layers =
···
550
391
) dep_bhs
551
392
in
552
393
let own_compile = Hashtbl.find compile_nodes build_hash in
394
+
let blessed = match Hashtbl.find_opt build_hash_blessed build_hash with
395
+
| Some true -> true | _ -> false in
553
396
let odoc_tool = Option.get (find_odoc_tool_for_hash build_hash) in
554
397
let composite_tool_hash = Day11_layer.Hash.of_strings
555
398
[ driver_tool.hash; odoc_tool.hash ] in
556
-
let universe = Command.compute_universe_hash [ build_node.hash ] in
557
-
let dep_hashes = List.map (fun (bl : build) -> bl.hash)
558
-
dep_compile_layers in
399
+
let dep_hashes = List.sort String.compare
400
+
(List.map (fun (bl : build) -> bl.hash) dep_compile_layers) in
559
401
let link_hash = Day11_layer.Hash.of_strings
560
-
([ "link"; own_compile.hash; universe; composite_tool_hash ]
402
+
([ "link"; own_compile.hash; composite_tool_hash;
403
+
(if blessed then "blessed" else "unblessed") ]
561
404
@ dep_hashes) in
562
405
let ln : build = { hash = link_hash; pkg = build_node.pkg;
563
-
deps = [ build_node; own_compile ] @ dep_compile_layers; universe = Day11_solution.Universe.dummy } in
406
+
deps = [ build_node; own_compile ] @ dep_compile_layers;
407
+
universe = Day11_solution.Universe.dummy } in
564
408
link_nodes_list := ln :: !link_nodes_list
565
409
) compile_nodes;
566
410
let compile_list = Hashtbl.fold (fun _ cn acc -> cn :: acc) compile_nodes [] in
567
411
let doc_all_list = Hashtbl.fold (fun _ dn acc -> dn :: acc) doc_all_nodes [] in
568
412
let all_doc_nodes = nodes @ tool_nodes @ compile_list
569
413
@ doc_all_list @ !link_nodes_list in
570
-
Printf.printf " Doc DAG: %d build + %d tool + %d doc-all + %d compile + %d link nodes\n%!"
571
-
(List.length nodes) (List.length tool_nodes)
572
-
(List.length doc_all_list) (List.length compile_list)
573
-
(List.length !link_nodes_list);
574
-
Day11_lib.Run_log.write_dag_structure run_log all_doc_nodes;
575
-
(* Track results *)
576
-
let compile_results : (string, build) Hashtbl.t = Hashtbl.create 64 in
577
-
let doc_count = Atomic.make 0 in
578
-
let doc_html = Atomic.make 0 in
414
+
(* Build immutable dispatch tables *)
415
+
let build_to_doc_hash : (string, string) Hashtbl.t = Hashtbl.create 64 in
416
+
List.iter (fun (build_hash, _cn) ->
417
+
let cn = Hashtbl.find compile_nodes build_hash in
418
+
Hashtbl.replace build_to_doc_hash build_hash cn.hash
419
+
) compile_snapshot;
420
+
List.iter (fun (build_hash, _dn) ->
421
+
let dn = Hashtbl.find doc_all_nodes build_hash in
422
+
Hashtbl.replace build_to_doc_hash build_hash dn.hash
423
+
) doc_all_snapshot;
579
424
let compile_to_build : (string, string) Hashtbl.t = Hashtbl.create 64 in
580
425
List.iter (fun (build_hash, _cn) ->
581
426
let cn = Hashtbl.find compile_nodes build_hash in
···
593
438
Hashtbl.replace link_to_build ln.hash build_node.hash
594
439
| _ -> ()
595
440
) !link_nodes_list;
596
-
(* Index for dispatch *)
597
441
let compile_set = Hashtbl.create 64 in
598
-
List.iter (fun (cn : build) -> Hashtbl.replace compile_set cn.hash cn) compile_list;
442
+
List.iter (fun (cn : build) -> Hashtbl.replace compile_set cn.hash ()) compile_list;
599
443
let doc_all_set = Hashtbl.create 64 in
600
-
List.iter (fun (dn : build) -> Hashtbl.replace doc_all_set dn.hash dn) doc_all_list;
444
+
List.iter (fun (dn : build) -> Hashtbl.replace doc_all_set dn.hash ()) doc_all_list;
601
445
let link_set = Hashtbl.create 64 in
602
-
List.iter (fun (ln : build) -> Hashtbl.replace link_set ln.hash ln) !link_nodes_list;
446
+
List.iter (fun (ln : build) -> Hashtbl.replace link_set ln.hash ()) !link_nodes_list;
603
447
let tool_node_set = Hashtbl.create 64 in
604
448
List.iter (fun (n : build) ->
605
-
Hashtbl.replace tool_node_set n.hash ()
606
-
) tool_nodes;
607
-
(* Priority: link=3, doc-all/compile=2, tool=1, build=0 *)
449
+
Hashtbl.replace tool_node_set n.hash ()) tool_nodes;
450
+
{ all_nodes = all_doc_nodes; build_by_hash; build_to_doc_hash;
451
+
build_hash_blessed; doc_dep_hashes;
452
+
compile_to_build; doc_all_to_build; link_to_build;
453
+
compile_set; doc_all_set; link_set; tool_node_set;
454
+
find_odoc_tool_for_hash; driver_tool }
455
+
456
+
(** Build a dispatch function from the plan tables. *)
457
+
let make_dispatch benv ~os_dir ~(plan : internal_plan) ~tool_source_dirs
458
+
~mounts ~build_one =
459
+
fun env (node : build) ->
460
+
if Hashtbl.mem plan.compile_set node.hash then begin
461
+
match Hashtbl.find_opt plan.compile_to_build node.hash with
462
+
| None -> true
463
+
| Some build_hash ->
464
+
let build_node = Hashtbl.find plan.build_by_hash build_hash in
465
+
let odoc_tool = plan.find_odoc_tool_for_hash build_hash in
466
+
compile_package env benv ~os_dir ~odoc_tool
467
+
~build_hash_blessed:plan.build_hash_blessed
468
+
~driver_tool:plan.driver_tool ~build_to_doc_hash:plan.build_to_doc_hash
469
+
~dag_hash:node.hash build_node
470
+
end else if Hashtbl.mem plan.doc_all_set node.hash then begin
471
+
match Hashtbl.find_opt plan.doc_all_to_build node.hash with
472
+
| None -> true
473
+
| Some build_hash ->
474
+
let build_node = Hashtbl.find plan.build_by_hash build_hash in
475
+
let odoc_tool = plan.find_odoc_tool_for_hash build_hash in
476
+
doc_all_package env benv ~os_dir ~odoc_tool
477
+
~build_hash_blessed:plan.build_hash_blessed
478
+
~driver_tool:plan.driver_tool ~build_to_doc_hash:plan.build_to_doc_hash
479
+
~dag_hash:node.hash build_node
480
+
end else if Hashtbl.mem plan.link_set node.hash then begin
481
+
match Hashtbl.find_opt plan.link_to_build node.hash with
482
+
| None -> true
483
+
| Some build_hash ->
484
+
let build_node = Hashtbl.find plan.build_by_hash build_hash in
485
+
let compile_hash = match Hashtbl.find_opt plan.build_to_doc_hash build_hash with
486
+
| Some h -> h | None -> "" in
487
+
let odoc_tool = plan.find_odoc_tool_for_hash build_hash in
488
+
link_package env benv ~os_dir ~odoc_tool
489
+
~build_hash_blessed:plan.build_hash_blessed
490
+
~driver_tool:plan.driver_tool ~build_to_doc_hash:plan.build_to_doc_hash
491
+
~doc_dep_hashes:plan.doc_dep_hashes ~build_hash ~compile_hash
492
+
~dag_hash:node.hash build_node
493
+
end else begin
494
+
let name = OpamPackage.name node.pkg in
495
+
match OpamPackage.Name.Map.find_opt name tool_source_dirs with
496
+
| Some dir ->
497
+
let src_mount = Day11_container.Mount.bind_ro ~src:dir "/home/opam/src" in
498
+
let strategy = Day11_opam_build.Tools.source_dir_strategy node.pkg in
499
+
(match Day11_opam_build.Build_layer.build env benv
500
+
~mounts:(src_mount :: mounts) node ~strategy () with
501
+
| Day11_opam_build.Types.Success _ -> true | _ -> false)
502
+
| None -> build_one node
503
+
end
504
+
505
+
(* ── Public API ──────────────────────────────────────────────── *)
506
+
507
+
type node_kind = Build | Tool | Compile | Doc_all | Link
508
+
509
+
type doc_plan = {
510
+
all_nodes : Build.t list;
511
+
node_kind : Build.t -> node_kind;
512
+
build_one : Eio_unix.Stdenv.base -> Build.t -> bool;
513
+
}
514
+
515
+
let node_kind_of_plan (plan : internal_plan) (n : build) =
516
+
if Hashtbl.mem plan.link_set n.hash then Link
517
+
else if Hashtbl.mem plan.compile_set n.hash then Compile
518
+
else if Hashtbl.mem plan.doc_all_set n.hash then Doc_all
519
+
else if Hashtbl.mem plan.tool_node_set n.hash then Tool
520
+
else Build
521
+
522
+
let run env benv ~np ~os_dir ~(driver_tool : Tool.t) ~odoc_tools
523
+
~tool_source_dirs ~mounts
524
+
~run_log
525
+
~build_one ~nodes ~solutions ~blessing_maps:_ =
526
+
let plan = build_internal_plan ~os_dir ~driver_tool ~odoc_tools
527
+
~nodes ~solutions in
528
+
Printf.printf " Doc DAG: %d total nodes\n%!" (List.length plan.all_nodes);
529
+
Day11_lib.Run_log.write_dag_structure run_log plan.all_nodes;
530
+
let doc_count = Atomic.make 0 in
608
531
let node_priority (n : build) =
609
-
if Hashtbl.mem link_set n.hash then 3
610
-
else if Hashtbl.mem compile_set n.hash then 2
611
-
else if Hashtbl.mem doc_all_set n.hash then 2
612
-
else if Hashtbl.mem tool_node_set n.hash then 1
532
+
if Hashtbl.mem plan.link_set n.hash then 3
533
+
else if Hashtbl.mem plan.compile_set n.hash then 2
534
+
else if Hashtbl.mem plan.doc_all_set n.hash then 2
535
+
else if Hashtbl.mem plan.tool_node_set n.hash then 1
613
536
else 0
614
537
in
615
-
(* Pre-populate compile_results for cached compile/doc-all layers *)
616
-
List.iter (fun (build_hash, _cn) ->
617
-
let cn = Hashtbl.find compile_nodes build_hash in
618
-
let layer_dir = Build.dir ~os_dir cn in
619
-
let layer_json = Fpath.(layer_dir / "layer.json") in
620
-
if Bos.OS.File.exists layer_json |> Result.get_ok then
621
-
match Day11_layer.Meta.load layer_json with
622
-
| Ok meta when meta.exit_status = 0 ->
623
-
Hashtbl.replace compile_results build_hash cn
624
-
| _ -> ()
625
-
) compile_snapshot;
626
-
List.iter (fun (build_hash, _dn) ->
627
-
let dn = Hashtbl.find doc_all_nodes build_hash in
628
-
let layer_dir = Build.dir ~os_dir dn in
629
-
let layer_json = Fpath.(layer_dir / "layer.json") in
630
-
if Bos.OS.File.exists layer_json |> Result.get_ok then
631
-
match Day11_layer.Meta.load layer_json with
632
-
| Ok meta when meta.exit_status = 0 ->
633
-
Hashtbl.replace compile_results build_hash dn
634
-
| _ -> ()
635
-
) doc_all_snapshot;
636
538
let open Day11_opam_build.Dag_executor in
637
539
let is_cached node =
638
-
let layer_dir = Day11_opam_layer.Build.dir ~os_dir node in
639
-
let layer_json = Fpath.(layer_dir / "layer.json") in
640
-
if not (Bos.OS.File.exists layer_json |> Result.get_ok) then
540
+
let layer = Build.layer ~os_dir node in
541
+
if not (Layer.exists layer) then
641
542
Not_cached
642
543
else begin
643
-
Day11_layer.Last_used.touch layer_dir;
644
-
let meta_ok = match Day11_layer.Meta.load layer_json with
645
-
| Ok meta -> meta.exit_status = 0
646
-
| Error _ -> false
647
-
in
648
-
if not meta_ok then Cached_fail
544
+
Day11_layer.Last_used.touch (Layer.dir layer);
545
+
if not (Layer.is_ok layer) then Cached_fail
546
+
(* For doc layers, validate that all dep compile layers are present.
547
+
A cached doc layer built with incomplete deps has bad xrefs. *)
548
+
else if (Hashtbl.mem plan.compile_set node.hash ||
549
+
Hashtbl.mem plan.doc_all_set node.hash ||
550
+
Hashtbl.mem plan.link_set node.hash) &&
551
+
not (Doc_build.validate_cached_doc ~os_dir (Layer.dir layer))
552
+
then begin
553
+
Printf.printf " Invalidating %s: missing dep compile layers\n%!"
554
+
(OpamPackage.to_string node.pkg);
555
+
ignore (Bos.OS.Dir.delete ~recurse:true (Layer.dir layer));
556
+
Not_cached
557
+
end
649
558
else Cached_ok
650
559
end
651
560
in
561
+
let dispatch = make_dispatch benv ~os_dir ~plan ~tool_source_dirs
562
+
~mounts ~build_one in
652
563
let doc_cascaded : (string, unit) Hashtbl.t = Hashtbl.create 256 in
564
+
let node_kind = node_kind_of_plan plan in
653
565
Day11_opam_build.Dag_executor.execute env ~np ~priority:node_priority ~is_cached
654
566
~on_complete:(fun ~stats node success ->
655
-
let open Day11_opam_build.Dag_executor in
656
567
if Hashtbl.mem doc_cascaded node.hash then ()
657
568
else begin
658
569
let status = if success then "ok" else "fail" in
659
-
let kind =
660
-
if Hashtbl.mem compile_set node.hash then "compile"
661
-
else if Hashtbl.mem doc_all_set node.hash then "doc-all"
662
-
else if Hashtbl.mem link_set node.hash then "link"
663
-
else if Hashtbl.mem tool_node_set node.hash then "tool"
664
-
else "build"
665
-
in
570
+
let kind = match node_kind node with
571
+
| Compile -> "compile" | Doc_all -> "doc-all"
572
+
| Link -> "link" | Tool -> "tool" | Build -> "build" in
666
573
let layer = Fpath.to_string
667
574
(Day11_opam_layer.Build.dir ~os_dir node) in
668
575
Day11_lib.Run_log.log_build_result run_log
669
576
~pkg:(OpamPackage.to_string node.pkg)
670
577
~hash:node.hash ~status ~failed_dep:None
671
578
~kind ~layer_dir:layer ();
579
+
if success && (Hashtbl.mem plan.doc_all_set node.hash ||
580
+
Hashtbl.mem plan.link_set node.hash) then
581
+
Atomic.incr doc_count;
672
582
if stats.completed mod 100 = 0 || not success then
673
583
Printf.printf " [%d/%d, %d ok, %d failed, %d cascade] %s: %s\n%!"
674
584
stats.completed stats.total stats.ok stats.failed
···
677
587
end)
678
588
~on_cascade:(fun ~failed ~failed_dep ->
679
589
Hashtbl.replace doc_cascaded failed.hash ();
680
-
let kind =
681
-
if Hashtbl.mem compile_set failed.hash then "compile"
682
-
else if Hashtbl.mem doc_all_set failed.hash then "doc-all"
683
-
else if Hashtbl.mem link_set failed.hash then "link"
684
-
else "build"
685
-
in
590
+
let kind = match node_kind failed with
591
+
| Compile -> "compile" | Doc_all -> "doc-all"
592
+
| Link -> "link" | _ -> "build" in
686
593
Day11_lib.Run_log.log_build_result run_log
687
594
~pkg:(OpamPackage.to_string failed.pkg)
688
595
~hash:failed.hash ~status:"cascade"
689
596
~failed_dep:(Some (OpamPackage.to_string failed_dep.pkg))
690
597
~kind ())
691
-
all_doc_nodes
598
+
plan.all_nodes
692
599
(fun node ->
693
-
if Hashtbl.mem compile_set node.hash then begin
694
-
(* Compile-only phase (for packages needing separate link) *)
695
-
match Hashtbl.find_opt compile_to_build node.hash with
696
-
| None -> true
697
-
| Some build_hash ->
698
-
let build_node = Hashtbl.find build_by_hash build_hash in
699
-
current_build_hash := build_hash;
700
-
(match compile_package env benv ~os_dir ~driver_tool ~odoc_tools
701
-
~build_hash_blessed ~find_odoc_tool ~compile_results build_node with
702
-
| Some _bl -> true
703
-
| None -> true)
704
-
end else if Hashtbl.mem doc_all_set node.hash then begin
705
-
(* Combined doc-all phase *)
706
-
match Hashtbl.find_opt doc_all_to_build node.hash with
707
-
| None -> true
708
-
| Some build_hash ->
709
-
let build_node = Hashtbl.find build_by_hash build_hash in
710
-
current_build_hash := build_hash;
711
-
(match doc_all_package env benv ~os_dir ~driver_tool ~odoc_tools
712
-
~build_hash_blessed ~find_odoc_tool ~compile_results
713
-
~build_hash
714
-
build_node with
715
-
| Some n ->
716
-
Atomic.incr doc_count;
717
-
ignore (Atomic.fetch_and_add doc_html n);
718
-
true
719
-
| None -> true)
720
-
end else if Hashtbl.mem link_set node.hash then begin
721
-
(* Link phase (for packages needing separate link) *)
722
-
match Hashtbl.find_opt link_to_build node.hash with
723
-
| None -> true
724
-
| Some build_hash ->
725
-
let build_node = Hashtbl.find build_by_hash build_hash in
726
-
current_build_hash := build_hash;
727
-
(match link_package env benv ~os_dir ~driver_tool ~odoc_tools
728
-
~build_hash_blessed ~find_odoc_tool ~compile_results
729
-
~doc_dep_hashes
730
-
~build_hash
731
-
build_node with
732
-
| Some n ->
733
-
Atomic.incr doc_count;
734
-
ignore (Atomic.fetch_and_add doc_html n);
735
-
true
736
-
| None -> true)
737
-
end else begin
738
-
(* Build or tool node *)
739
-
let name = OpamPackage.name node.pkg in
740
-
match OpamPackage.Name.Map.find_opt name tool_source_dirs with
741
-
| Some dir ->
742
-
(* Pinned tool package: source mount + source_dir_strategy *)
743
-
let src_mount = Day11_container.Mount.bind_ro
744
-
~src:dir "/home/opam/src" in
745
-
let strategy = Day11_opam_build.Tools.source_dir_strategy node.pkg in
746
-
(match Day11_opam_build.Build_layer.build env benv
747
-
~mounts:(src_mount :: mounts) node ~strategy () with
748
-
| Day11_opam_build.Types.Success _ -> true
749
-
| _ -> false)
750
-
| None ->
751
-
build_one node
752
-
end);
753
-
(* Count all successful doc layers (including cached ones that
754
-
were pre-resolved and skipped the executor callback).
755
-
HTML count only from this run (cached in atomics). *)
600
+
let ok = dispatch env node in
601
+
if ok && (Hashtbl.mem plan.doc_all_set node.hash ||
602
+
Hashtbl.mem plan.link_set node.hash) then
603
+
Atomic.incr doc_count;
604
+
ok);
605
+
(* Count results *)
756
606
let total_doc_count = ref 0 in
757
-
let count_success node =
758
-
let dd = Build.dir ~os_dir node in
759
-
let layer_json = Fpath.(dd / "layer.json") in
760
-
if Bos.OS.File.exists layer_json |> Result.get_ok then
761
-
match Day11_layer.Meta.load layer_json with
762
-
| Ok meta when meta.exit_status = 0 -> incr total_doc_count
763
-
| _ -> ()
607
+
let count_success hash =
608
+
if Layer.is_ok (Layer.of_hash ~os_dir hash) then incr total_doc_count
764
609
in
765
-
List.iter (fun (dn : build) -> count_success dn) doc_all_list;
766
-
List.iter (fun (ln : build) -> count_success ln) !link_nodes_list;
767
-
(* Count HTML files from the output directory *)
610
+
Hashtbl.iter (fun _ h -> count_success h) plan.build_to_doc_hash;
768
611
let html_root = Fpath.(os_dir / "html") in
769
612
let total_html =
770
613
if Bos.OS.Dir.exists html_root |> Result.get_ok then
···
788
631
| _ -> None
789
632
) solutions
790
633
791
-
let build_tools_and_run env benv ~np ~os_dir ~packages ~repos ~opam_env:_
792
-
~mounts ~driver_compiler ~odoc_repo ~build_one
793
-
~opam_repositories:_
794
-
~cache ~run_log
795
-
~nodes ~solutions ~blessing_maps =
796
-
Printf.printf "\nPlanning doc tools...\n%!";
634
+
(** Resolve tools (driver + per-compiler odoc). Returns the tools
635
+
and source dirs, or None if driver solving fails. *)
636
+
let resolve_tools benv ~packages ~repos ~odoc_repo ~cache
637
+
?driver_compiler ~solutions () =
797
638
let all_pin_dirs, all_source_dirs = match odoc_repo with
798
639
| Some dir ->
799
-
Printf.printf "Using local odoc from %s\n%!" dir;
800
640
let pins = Day11_opam_build.Tools.read_pins_from_dir dir in
801
641
let source_dirs = OpamPackage.Name.Map.fold (fun name _ acc ->
802
642
OpamPackage.Name.Map.add name dir acc
803
643
) pins OpamPackage.Name.Map.empty in
804
644
([ dir ], source_dirs)
645
+
| None -> ([], OpamPackage.Name.Map.empty)
646
+
in
647
+
let driver_compiler = match driver_compiler with
648
+
| Some c -> c
805
649
| None ->
806
-
([], OpamPackage.Name.Map.empty)
650
+
let compilers = unique_compilers solutions in
651
+
(match List.sort (fun a b ->
652
+
OpamPackage.Version.compare
653
+
(OpamPackage.version b) (OpamPackage.version a)) compilers with
654
+
| c :: _ -> c
655
+
| [] -> OpamPackage.of_string "ocaml-base-compiler.5.4.1")
807
656
in
808
-
(* 1. Plan driver with fixed compiler *)
809
657
let driver_pkg = OpamPackage.of_string "odoc-driver.3.1.0" in
810
-
Printf.printf "Planning doc driver (%s)...\n%!"
811
-
(OpamPackage.to_string driver_compiler);
812
-
let driver_result = Day11_opam_build.Tools.plan_tool benv
658
+
match Day11_opam_build.Tools.plan_tool benv
813
659
~packages ~repos ~doc:false ~cache
814
-
~ocaml_version:driver_compiler driver_pkg in
815
-
match driver_result with
816
-
| Error (`Msg e) ->
817
-
Printf.printf "Doc driver solve failed: %s\n%!" e
818
-
| Ok (driver_tool, _driver_source_dirs) ->
819
-
Printf.printf "Driver: %d nodes\n%!" (List.length driver_tool.builds);
820
-
(* 2. Plan odoc per unique compiler in batch *)
660
+
~ocaml_version:driver_compiler driver_pkg with
661
+
| Error _ -> None
662
+
| Ok (driver_tool, _) ->
821
663
let compiler_versions = unique_compilers solutions in
822
-
if compiler_versions = [] then
823
-
Printf.printf "No compiler versions found in solutions, skipping docs\n%!"
824
-
else begin
664
+
if compiler_versions = [] then None
665
+
else
825
666
let odoc_pkg = match odoc_repo with
826
667
| Some _ -> OpamPackage.of_string "odoc.dev"
827
668
| None -> OpamPackage.of_string "odoc.3.1.0"
828
669
in
829
670
let odoc_tools = List.filter_map (fun compiler_v ->
830
-
Printf.printf "Planning odoc for %s...\n%!"
831
-
(OpamPackage.to_string compiler_v);
832
671
match Day11_opam_build.Tools.plan_tool benv
833
672
~packages ~repos ~pin_dirs:all_pin_dirs
834
673
~source_dirs:all_source_dirs ~doc:false ~cache
835
674
~ocaml_version:compiler_v odoc_pkg with
836
-
| Error (`Msg e) ->
837
-
Printf.printf "Odoc solve for %s failed: %s\n%!"
838
-
(OpamPackage.to_string compiler_v) e;
839
-
None
840
-
| Ok (tool, _source_dirs) ->
841
-
Printf.printf " %s: %d nodes\n%!"
842
-
(OpamPackage.to_string compiler_v) (List.length tool.builds);
843
-
Some (compiler_v, tool)
675
+
| Error _ -> None
676
+
| Ok (tool, _) -> Some (compiler_v, tool)
844
677
) compiler_versions in
845
-
(* 3. Run unified DAG: build + tools + compile + link *)
678
+
Some (driver_tool, odoc_tools, all_source_dirs)
679
+
680
+
let plan_doc_dag benv ~os_dir ?driver_compiler ~packages ~repos
681
+
~mounts ~odoc_repo ~build_one ~cache
682
+
~nodes ~solutions ~blessing_maps:_ () =
683
+
match resolve_tools benv ~packages ~repos ~odoc_repo ~cache
684
+
?driver_compiler ~solutions () with
685
+
| None -> None
686
+
| Some (driver_tool, odoc_tools, all_source_dirs) ->
687
+
let plan = build_internal_plan ~os_dir ~driver_tool ~odoc_tools
688
+
~nodes ~solutions in
689
+
let dispatch = make_dispatch benv ~os_dir ~plan
690
+
~tool_source_dirs:all_source_dirs ~mounts ~build_one in
691
+
Some { all_nodes = plan.all_nodes;
692
+
node_kind = node_kind_of_plan plan;
693
+
build_one = dispatch }
694
+
695
+
let build_tools_and_run env benv ~np ~os_dir ?driver_compiler ~packages ~repos ~opam_env:_
696
+
~mounts ~odoc_repo ~build_one
697
+
~opam_repositories:_
698
+
~cache ~run_log
699
+
~nodes ~solutions ~blessing_maps:_ () =
700
+
Printf.printf "\nPlanning doc tools...\n%!";
701
+
match resolve_tools benv ~packages ~repos ~odoc_repo ~cache
702
+
?driver_compiler ~solutions () with
703
+
| None ->
704
+
Printf.printf "Tool solving failed, skipping docs\n%!"
705
+
| Some (driver_tool, odoc_tools, all_source_dirs) ->
846
706
Printf.printf "Running unified build+doc DAG...\n%!";
847
707
let doc_count, doc_html =
848
708
run env benv ~np ~os_dir ~driver_tool ~odoc_tools
849
709
~tool_source_dirs:all_source_dirs ~mounts
850
710
~run_log
851
-
~build_one ~nodes ~solutions ~blessing_maps in
711
+
~build_one ~nodes ~solutions ~blessing_maps:[] in
852
712
Printf.printf "\n=== Docs: %d packages, %d HTML files ===\n%!"
853
713
doc_count doc_html
854
-
end
+47
-5
doc/generate.mli
+47
-5
doc/generate.mli
···
45
45
solutions:(OpamPackage.t * Day11_solution.Solve_result.t) list ->
46
46
blessing_maps:(OpamPackage.t * bool OpamPackage.Map.t) list ->
47
47
int * int
48
+
(** Run the unified build+doc DAG with pre-resolved tools.
49
+
Returns [(doc_count, html_file_count)]. Uses {!Day11_opam_build.Dag_executor}
50
+
for parallel execution with priority ordering (link > compile > tool > build). *)
51
+
52
+
(** {1 Planned doc DAG}
53
+
54
+
[plan_doc_dag] constructs the doc DAG nodes without executing them.
55
+
This is useful for external executors (like OCurrent) that want to
56
+
create their own scheduling nodes from the DAG. *)
57
+
58
+
type node_kind = Build | Tool | Compile | Doc_all | Link
59
+
60
+
type doc_plan = {
61
+
all_nodes : Day11_opam_layer.Build.t list;
62
+
(** All nodes in the unified DAG (build + tool + doc). *)
63
+
node_kind : Day11_opam_layer.Build.t -> node_kind;
64
+
(** Classify a node by its phase. *)
65
+
build_one : Eio_unix.Stdenv.base -> Day11_opam_layer.Build.t -> bool;
66
+
(** Callback to build a single node. Takes the Eio env and handles
67
+
dispatch to the correct phase (build, tool, compile, link, doc-all). *)
68
+
}
69
+
70
+
val plan_doc_dag :
71
+
Day11_opam_build.Types.build_env ->
72
+
os_dir:Fpath.t ->
73
+
?driver_compiler:OpamPackage.t ->
74
+
packages:Day11_opam.Git_packages.t ->
75
+
repos:(string * string) list ->
76
+
mounts:Day11_container.Mount.t list ->
77
+
odoc_repo:string option ->
78
+
build_one:(Day11_opam_layer.Build.t -> bool) ->
79
+
cache:Day11_opam_build.Hash_cache.t ->
80
+
nodes:Day11_opam_layer.Build.t list ->
81
+
solutions:(OpamPackage.t * Day11_solution.Solve_result.t) list ->
82
+
blessing_maps:(OpamPackage.t * bool OpamPackage.Map.t) list ->
83
+
unit ->
84
+
doc_plan option
85
+
(** Plan the doc DAG: solve for tools, construct compile/link/doc-all
86
+
nodes with deterministic hashes, and return the unified DAG.
87
+
Returns [None] if tool solving fails. *)
48
88
49
89
val build_tools_and_run :
50
90
Eio_unix.Stdenv.base ->
51
91
Day11_opam_build.Types.build_env ->
52
92
np:int ->
53
93
os_dir:Fpath.t ->
94
+
?driver_compiler:OpamPackage.t ->
54
95
packages:Day11_opam.Git_packages.t ->
55
96
repos:(string * string) list ->
56
97
opam_env:(string -> OpamVariable.variable_contents option) ->
57
98
mounts:Day11_container.Mount.t list ->
58
-
driver_compiler:OpamPackage.t ->
59
99
odoc_repo:string option ->
60
100
build_one:(Day11_opam_layer.Build.t -> bool) ->
61
101
opam_repositories:string list ->
···
64
104
nodes:Day11_opam_layer.Build.t list ->
65
105
solutions:(OpamPackage.t * Day11_solution.Solve_result.t) list ->
66
106
blessing_maps:(OpamPackage.t * bool OpamPackage.Map.t) list ->
107
+
unit ->
67
108
unit
68
109
(** Plan doc tools (driver + per-compiler odoc) and run a unified DAG
69
-
that builds packages, tools, and docs in parallel. The driver is
70
-
solved with [driver_compiler]; odoc is solved once per unique
71
-
compiler in [solutions]. When [odoc_repo] is given, odoc packages
72
-
are pinned from that local checkout. *)
110
+
that builds packages, tools, and docs in parallel. When
111
+
[driver_compiler] is omitted, the latest compiler from the
112
+
solutions is used. Odoc is solved once per unique compiler in
113
+
[solutions]. When [odoc_repo] is given, odoc packages are pinned
114
+
from that local checkout. *)
+1
-1
doc/test/test_doc_integration.ml
+1
-1
doc/test/test_doc_integration.ml
···
14
14
let switch = "default"
15
15
let make_base () : Day11_layer.Base.t =
16
16
{ hash = Day11_opam_build.Base.build_hash ~os_distribution:"debian"
17
-
~os_version:"bookworm" ~arch:"x86_64";
17
+
~os_version:"bookworm" ~arch:"x86_64" ();
18
18
dir = base_dir;
19
19
image = "debian:bookworm" }
20
20
+1
-1
doc/test/test_generate_docs.ml
+1
-1
doc/test/test_generate_docs.ml
···
12
12
let _switch = "default"
13
13
let make_base () : Day11_layer.Base.t =
14
14
{ hash = Day11_opam_build.Base.build_hash ~os_distribution:"debian"
15
-
~os_version:"bookworm" ~arch:"x86_64";
15
+
~os_version:"bookworm" ~arch:"x86_64" ();
16
16
dir = base_dir;
17
17
image = "debian:bookworm" }
18
18
+37
doc/test/test_xref_resolution.sh
+37
doc/test/test_xref_resolution.sh
···
1
+
#!/bin/bash
2
+
# Test that doc generation produces no unresolved cross-references.
3
+
#
4
+
# This catches the bug where doc layers are cached with incomplete
5
+
# dep compile layers, producing HTML with xref-unresolved spans.
6
+
#
7
+
# Usage: test_xref_resolution.sh [--profile NAME] [PACKAGE]
8
+
# Default: base.v0.17.3 with profile ocaml-ci
9
+
10
+
set -e
11
+
12
+
PROFILE="${PROFILE:-ocaml-ci}"
13
+
PACKAGE="${1:-base.v0.17.3}"
14
+
OUTPUT_DIR=$(mktemp -d)
15
+
16
+
echo "Testing xref resolution for $PACKAGE"
17
+
echo "Output: $OUTPUT_DIR"
18
+
19
+
# Build with docs
20
+
day11 build --profile "$PROFILE" "$PACKAGE" --with-doc "$OUTPUT_DIR" -j 4
21
+
22
+
# Check for unresolved xrefs
23
+
UNRESOLVED=$(find "$OUTPUT_DIR" -name "*.html" -exec grep -l 'xref-unresolved' {} \; 2>/dev/null)
24
+
25
+
if [ -n "$UNRESOLVED" ]; then
26
+
echo "FAIL: Found unresolved cross-references in:"
27
+
echo "$UNRESOLVED" | head -10
28
+
echo ""
29
+
echo "Example:"
30
+
echo "$UNRESOLVED" | head -1 | xargs grep -o 'class="xref-unresolved">[^<]*<' | head -5
31
+
rm -rf "$OUTPUT_DIR"
32
+
exit 1
33
+
fi
34
+
35
+
N_HTML=$(find "$OUTPUT_DIR" -name "*.html" | wc -l)
36
+
echo "OK: $N_HTML HTML files, no unresolved xrefs"
37
+
rm -rf "$OUTPUT_DIR"
+1
-1
doc/tool_layer.ml
+1
-1
doc/tool_layer.ml
···
17
17
@ [ install ])
18
18
19
19
let driver_exists ~layer_dir =
20
-
Sys.file_exists (Fpath.to_string Fpath.(layer_dir / "layer.json"))
20
+
Day11_layer.Layer.exists { hash = ""; dir = layer_dir }
21
21
22
22
let has_odoc_driver_voodoo ~layer_dir =
23
23
let bin = Fpath.(layer_dir / "fs" / "home" / "opam" / ".opam"
+9
dune-project
+9
dune-project
+1
-2
jtw/tool_layer.ml
+1
-2
jtw/tool_layer.ml
···
68
68
let extra_tool_targets = [ "js_top_worker-web" ]
69
69
70
70
let exists ~layer_dir =
71
-
Sys.file_exists
72
-
(Fpath.to_string Fpath.(layer_dir / "layer.json"))
71
+
Bos.OS.File.exists Fpath.(layer_dir / "layer.json") |> Result.get_ok
73
72
74
73
let has_jsoo ~layer_dir =
75
74
let path = Fpath.(layer_dir / "fs" / "home" / "opam" / ".opam"
+5
-3
layer/cli/layer_cli.ml
+5
-3
layer/cli/layer_cli.ml
···
27
27
28
28
let load_meta layer_dir =
29
29
L.Meta.load Fpath.(layer_dir / "layer.json")
30
+
(* layer_dir comes from fold_layers which walks the filesystem
31
+
directly — it doesn't have a hash, so we can't use Layer.t here *)
30
32
31
33
(** List every non-layer-core file in the layer directory. Used to
32
34
show what sidecars etc. are present. *)
···
277
279
(* ── log ─────────────────────────────────────────────────────────── *)
278
280
279
281
let cmd_log os_dir hash_prefix =
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
282
+
with_resolved_layer os_dir hash_prefix @@ fun os_dir name _layer_dir ->
283
+
let layer = L.Layer.of_hash ~os_dir name in
284
+
match Bos.OS.File.read (L.Layer.log_path layer) with
283
285
| Ok content -> print_string content; 0
284
286
| Error (`Msg e) -> Printf.eprintf "%s\n" e; 1
285
287
+30
layer/day11_layer.ml
+30
layer/day11_layer.ml
···
1
+
(** Content-addressed layer storage.
2
+
3
+
A layer is a directory on disk identified by its content hash.
4
+
It contains:
5
+
- [fs/] — the filesystem tree (overlayfs upper)
6
+
- [layer.json] — metadata ({!Meta.t})
7
+
- [layer.log] — build stdout/stderr
8
+
- optional sidecar files ([build.json], [doc.json], etc.) *)
9
+
10
+
(** {1 Core type} *)
11
+
12
+
type t = Layer.t = {
13
+
hash : string;
14
+
dir : Fpath.t;
15
+
}
16
+
17
+
include (Layer : module type of Layer with type t := t)
18
+
19
+
(** {1 Modules} *)
20
+
21
+
module Base = Base
22
+
module Dir = Dir
23
+
module Hash = Hash
24
+
module Import = Import
25
+
module Last_used = Last_used
26
+
module Layer = Layer
27
+
module Meta = Meta
28
+
module Scan = Scan
29
+
module Stack = Stack
30
+
module Symlinks = Symlinks
+1
layer/dune
+1
layer/dune
+26
layer/layer.ml
+26
layer/layer.ml
···
1
+
type t = {
2
+
hash : string;
3
+
dir : Fpath.t;
4
+
}
5
+
6
+
let of_hash ~os_dir hash =
7
+
let len = min 12 (String.length hash) in
8
+
let name = String.sub hash 0 len in
9
+
{ hash; dir = Fpath.(os_dir / name) }
10
+
11
+
let hash t = t.hash
12
+
let dir t = t.dir
13
+
let fs t = Fpath.(t.dir / "fs")
14
+
let meta_path t = Fpath.(t.dir / "layer.json")
15
+
let log_path t = Fpath.(t.dir / "layer.log")
16
+
17
+
let pp f t =
18
+
Fmt.pf f "%s" (String.sub t.hash 0 (min 12 (String.length t.hash)))
19
+
20
+
let exists t =
21
+
Bos.OS.File.exists (meta_path t) |> Result.get_ok
22
+
23
+
let is_ok t =
24
+
match Meta.load (meta_path t) with
25
+
| Ok meta -> meta.exit_status = 0
26
+
| Error _ -> false
+36
layer/layer.mli
+36
layer/layer.mli
···
1
+
(** A layer on disk.
2
+
3
+
A layer is identified by its content hash and lives at a directory
4
+
derived from that hash under the os_dir. The directory contains:
5
+
- [fs/] — the filesystem tree (overlayfs upper)
6
+
- [layer.json] — metadata ({!Meta.t})
7
+
- [layer.log] — build stdout/stderr
8
+
- optional sidecar files ([build.json], [doc.json], etc.) *)
9
+
10
+
type t = {
11
+
hash : string;
12
+
dir : Fpath.t;
13
+
}
14
+
15
+
val of_hash : os_dir:Fpath.t -> string -> t
16
+
(** [of_hash ~os_dir hash] constructs a layer reference from a hash.
17
+
Does not check whether the layer exists on disk. *)
18
+
19
+
val hash : t -> string
20
+
val dir : t -> Fpath.t
21
+
val fs : t -> Fpath.t
22
+
(** [fs t] is [t.dir / "fs"]. *)
23
+
24
+
val meta_path : t -> Fpath.t
25
+
(** [meta_path t] is [t.dir / "layer.json"]. *)
26
+
27
+
val log_path : t -> Fpath.t
28
+
(** [log_path t] is [t.dir / "layer.log"]. *)
29
+
30
+
val pp : Format.formatter -> t -> unit
31
+
32
+
val exists : t -> bool
33
+
(** [exists t] returns true if [layer.json] exists on disk. *)
34
+
35
+
val is_ok : t -> bool
36
+
(** [is_ok t] returns true if the layer exists and has exit_status = 0. *)
+1
-1
opam/dune
+1
-1
opam/dune
+37
-11
opam_build/base.ml
+37
-11
opam_build/base.ml
···
3
3
4
4
let hash ~image = Day11_layer.Hash.base_hash ~image
5
5
6
-
let build_hash ~os_distribution ~os_version ~arch:_ =
7
-
let image = Printf.sprintf "%s:%s" os_distribution os_version in
8
-
hash ~image
6
+
let build_hash ~os_distribution ~os_version ~arch:_ ?digest () =
7
+
match digest with
8
+
| Some d -> hash ~image:d
9
+
| None ->
10
+
let image = Printf.sprintf "%s:%s" os_distribution os_version in
11
+
hash ~image
9
12
10
13
let make_base_layer ~image ~base_dir : Day11_layer.Base.t =
11
14
{ hash = hash ~image; dir = base_dir; image }
15
+
16
+
let digest_file base_dir = Fpath.(base_dir / "base-digest")
17
+
18
+
let save_digest base_dir digest =
19
+
ignore (Bos.OS.File.write (digest_file base_dir) digest)
20
+
21
+
let load_digest base_dir =
22
+
match Bos.OS.File.read (digest_file base_dir) with
23
+
| Ok d -> Some (String.trim d)
24
+
| Error _ -> None
12
25
13
26
let ensure env ~cache_dir ~image =
14
27
let base_dir = Fpath.(cache_dir / "base") in
···
63
76
@@ run "install -m 755 _build/default/bin/main.exe /usr/local/bin/opam-build"
64
77
65
78
let generate_dockerfile ~os_distribution ~os_version ~arch ~uid ~gid
66
-
~repo_count ~has_opam_build_bin =
79
+
~repo_count ~has_opam_build_bin ?digest () =
67
80
let open Dockerfile in
68
-
let base_image = Printf.sprintf "%s:%s" os_distribution os_version in
81
+
let base_image = match digest with
82
+
| Some d -> Printf.sprintf "%s@%s" os_distribution d
83
+
| None -> Printf.sprintf "%s:%s" os_distribution os_version
84
+
in
69
85
let plat = platform arch in
70
86
(* Stage 1: download opam binary *)
71
87
let stage1 =
···
192
208
let load_cached ~cache_dir ~os_distribution ~os_version =
193
209
let base_dir = Fpath.(cache_dir / "base") in
194
210
let marker = Fpath.(base_dir / "fs" / "usr") in
195
-
let image = Printf.sprintf "%s:%s" os_distribution os_version in
196
-
if Bos.OS.Dir.exists marker |> Result.get_ok then
211
+
if Bos.OS.Dir.exists marker |> Result.get_ok then begin
212
+
(* Use stored digest if available, otherwise fall back to tag *)
213
+
let image = match load_digest base_dir with
214
+
| Some d -> d
215
+
| None -> Printf.sprintf "%s:%s" os_distribution os_version
216
+
in
197
217
Some (make_base_layer ~image ~base_dir)
198
-
else
218
+
end else
199
219
None
200
220
201
221
let build env ~cache_dir ~os_distribution ~os_version ~arch
202
-
~opam_repositories ~uid ~gid () =
222
+
~opam_repositories ~uid ~gid ?digest () =
203
223
let base_dir = Fpath.(cache_dir / "base") in
204
224
let marker = Fpath.(base_dir / "fs" / "usr") in
205
225
let image = Printf.sprintf "%s:%s" os_distribution os_version in
···
232
252
let dockerfile =
233
253
generate_dockerfile ~os_distribution ~os_version ~arch ~uid ~gid
234
254
~repo_count:(List.length opam_repositories)
235
-
~has_opam_build_bin
255
+
~has_opam_build_bin ?digest ()
236
256
in
237
257
let dockerfile_path = Fpath.(temp_dir / "Dockerfile") in
238
258
Bos.OS.File.write dockerfile_path
···
267
287
Fpath.(base_dir / "fs" / "home" / "opam"
268
288
/ ".opam" / "repo"
269
289
/ "state-*.cache"))));
270
-
Ok (make_base_layer ~image ~base_dir)
290
+
(* Save the digest so future loads use it for the hash *)
291
+
(match digest with
292
+
| Some d -> save_digest base_dir d
293
+
| None -> ());
294
+
let image_for_hash = match digest with
295
+
| Some d -> d | None -> image in
296
+
Ok (make_base_layer ~image:image_for_hash ~base_dir)
271
297
| Error _ as e -> e)
272
298
| `Exited n ->
273
299
(* Preserve log and Dockerfile before deleting temp dir *)
+24
-16
opam_build/base.mli
+24
-16
opam_build/base.mli
···
3
3
Builds and caches the root filesystem layer that all package builds
4
4
start from. The base contains a Debian image with opam, build tools,
5
5
and pre-initialised opam repositories. Docker is used to produce the
6
-
image, which is then imported as a layer for overlayfs use. *)
6
+
image, which is then imported as a layer for overlayfs use.
7
7
8
-
(** Ensure a base layer exists for the given Docker [image] tag, building
9
-
and importing it if not already cached. *)
8
+
When a [digest] is provided (e.g. [sha256:abc123...] from the
9
+
profile), the base image is pulled by digest for reproducibility.
10
+
The digest is saved alongside the base layer so future loads use
11
+
the same hash. *)
12
+
10
13
val ensure :
11
14
Eio_unix.Stdenv.base ->
12
15
cache_dir:Fpath.t ->
13
16
image:string ->
14
17
(Day11_layer.Base.t, [> Rresult.R.msg ]) result
18
+
(** Ensure a base layer exists for the given Docker [image] tag,
19
+
building and importing it if not already cached. *)
15
20
16
-
(** Build a base layer from scratch using the given OS distribution,
17
-
version, architecture, and opam repositories. The [uid] and [gid]
18
-
are set as the non-root user inside the image. *)
19
21
val build :
20
22
Eio_unix.Stdenv.base ->
21
23
cache_dir:Fpath.t ->
···
25
27
opam_repositories:Fpath.t list ->
26
28
uid:int ->
27
29
gid:int ->
30
+
?digest:string ->
28
31
unit ->
29
32
(Day11_layer.Base.t, [> Rresult.R.msg ]) result
33
+
(** Build a base layer from scratch. When [digest] is provided
34
+
(e.g. from {!Day11_batch.Profile.base_image_digest}), the
35
+
Dockerfile uses [debian\@sha256:...] instead of [debian:bookworm]
36
+
for a reproducible base. The digest is saved on disk so that
37
+
{!load_cached} returns a base with the correct hash. *)
30
38
31
-
(** Build the [opam-build] binary in a Docker container and cache it.
32
-
Returns the path to the cached binary. If [opam_build_repo] is
33
-
provided, that local checkout is used instead of cloning from GitHub. *)
34
39
val build_opam_build :
35
40
Eio_unix.Stdenv.base ->
36
41
cache_dir:Fpath.t ->
···
38
43
?opam_build_repo:Fpath.t ->
39
44
unit ->
40
45
(Fpath.t, [> Rresult.R.msg ]) result
46
+
(** Build the [opam-build] binary in a Docker container and cache it. *)
41
47
42
-
(** Return a read-only bind mount for the cached [opam-build] binary,
43
-
or [None] if it has not been built yet. *)
44
48
val opam_build_mount :
45
49
cache_dir:Fpath.t -> Day11_container.Mount.t option
50
+
(** Return a read-only bind mount for the cached [opam-build] binary. *)
46
51
47
-
(** Compute a content hash for a Docker image tag. *)
48
52
val hash : image:string -> string
53
+
(** Compute a content hash for a Docker image identifier (tag or digest). *)
49
54
50
-
(** Compute a content hash from OS distribution, version, and architecture. *)
51
55
val build_hash :
52
-
os_distribution:string -> os_version:string -> arch:string -> string
56
+
os_distribution:string -> os_version:string -> arch:string ->
57
+
?digest:string -> unit -> string
58
+
(** Compute the base hash. When [digest] is provided, it is used
59
+
instead of the tag name, ensuring the hash changes when the
60
+
upstream image is updated. *)
53
61
54
-
(** Load a previously cached base layer, returning [None] if the cache
55
-
directory does not contain a valid base image. *)
56
62
val load_cached :
57
63
cache_dir:Fpath.t ->
58
64
os_distribution:string -> os_version:string ->
59
65
Day11_layer.Base.t option
66
+
(** Load a previously cached base layer. Uses the stored digest
67
+
(if any) for the hash, otherwise falls back to the tag name. *)
+22
-19
opam_build/build_layer.ml
+22
-19
opam_build/build_layer.ml
···
76
76
Bos.Cmd.(v "chown" % "-R" % Printf.sprintf "%d:%d" uid gid
77
77
% Fpath.to_string home_dir))
78
78
79
-
(** Read the build result from an existing layer.json. *)
80
-
let result_of_layer_json layer_json (node : Build.t) =
81
-
match Day11_layer.Meta.load layer_json with
82
-
| Ok { exit_status = 0; _ } -> Types.Success node
83
-
| _ -> Types.Failure (Build.dir_name node)
79
+
module Layer = Day11_layer.Layer
80
+
81
+
(** Read the build result from an existing layer. *)
82
+
let result_of_layer layer (node : Build.t) =
83
+
if Layer.is_ok layer then Types.Success node
84
+
else Types.Failure (Build.dir_name node)
84
85
85
86
(** Extract the build result: move upper to layer, write generic
86
87
layer.json, then call [on_extract] so the caller can write any
87
88
domain-specific sidecar files. *)
88
-
let extract_layer env ~layer_dir ~layer_json ~upper ~pkg_str
89
+
let extract_layer env ~layer ~upper ~pkg_str
89
90
~(node : Build.t) ~(benv : Types.build_env)
90
91
~timing ~on_extract (run : Day11_exec.Run.t) =
91
92
let exit_code = match run.status with
···
94
95
in
95
96
Log.info (fun m -> m "Build %s: exit %d (%.1fs)"
96
97
pkg_str exit_code run.time);
97
-
let _ = Bos.OS.File.write Fpath.(layer_dir / "layer.log")
98
+
let layer_dir = Layer.dir layer in
99
+
let layer_json = Layer.meta_path layer in
100
+
let _ = Bos.OS.File.write (Layer.log_path layer)
98
101
(Printf.sprintf "=== STDOUT ===\n%s\n=== STDERR ===\n%s\n"
99
102
run.output run.errors) in
100
103
let _ = Day11_exec.Sudo.run env
101
104
Bos.Cmd.(v "mv" % Fpath.to_string upper
102
-
% Fpath.to_string Fpath.(layer_dir / "fs")) in
105
+
% Fpath.to_string (Layer.fs layer)) in
103
106
let dep_hashes =
104
107
List.map (fun (d : Build.t) -> d.hash) node.deps in
105
108
let disk_usage = match Day11_exec.Util.dir_size layer_dir with
···
131
134
in
132
135
List.iter walk node.deps;
133
136
Hashtbl.fold (fun hash () acc ->
134
-
Day11_layer.Dir.path ~os_dir hash :: acc
137
+
Layer.dir (Layer.of_hash ~os_dir hash) :: acc
135
138
) seen []
136
139
137
140
(** Main entry point. *)
···
157
160
| None ->
158
161
opam_build_prep_upper env ~uid:benv.uid ~gid:benv.gid
159
162
in
160
-
let layer_dir = Build.dir ~os_dir node in
161
-
let layer_json = Fpath.(layer_dir / "layer.json") in
162
-
if Bos.OS.File.exists layer_json |> Result.get_ok then begin
163
+
let layer = Build.layer ~os_dir node in
164
+
if Layer.exists layer then begin
163
165
Log.info (fun m -> m "Cache hit: %s (%s)" pkg_str layer_name);
164
-
Day11_layer.Last_used.touch layer_dir;
165
-
result_of_layer_json layer_json node
166
+
Day11_layer.Last_used.touch (Layer.dir layer);
167
+
result_of_layer layer node
166
168
end else begin
167
169
Log.info (fun m -> m "Building %s (%s)" pkg_str layer_name);
170
+
let layer_dir = Layer.dir layer in
168
171
let lock_file = Fpath.(os_dir / (layer_name ^ ".lock")) in
169
172
let _lock_result =
170
173
Day11_exec.Dir_lock.with_lock ~marker_file:(Fpath.v "layer.json")
···
202
205
| Ok (run, upper, timing) ->
203
206
strategy.cleanup env upper;
204
207
let _exit_code =
205
-
extract_layer env ~layer_dir ~layer_json ~upper
208
+
extract_layer env ~layer ~upper
206
209
~pkg_str ~node ~benv
207
210
~timing ~on_extract run in
208
211
ignore (Day11_exec.Sudo.rm_rf env (Fpath.parent upper));
···
220
223
created_at = "";
221
224
failed_dep = None;
222
225
} in
223
-
let _ = Day11_layer.Meta.save layer_json fail_meta in
224
-
on_extract ~layer_dir ~success:false;
226
+
let _ = Day11_layer.Meta.save (Layer.meta_path layer) fail_meta in
227
+
on_extract ~layer_dir:(Layer.dir layer) ~success:false;
225
228
Ok ())
226
229
in
227
-
if Bos.OS.File.exists layer_json |> Result.get_ok then
228
-
result_of_layer_json layer_json node
230
+
if Layer.exists layer then
231
+
result_of_layer layer node
229
232
else
230
233
Types.Failure layer_name
231
234
end
+29
opam_build/patches.mli
+29
opam_build/patches.mli
···
1
+
(** Package patches: load, hash, and apply via opam-build --patch.
2
+
3
+
Patches are stored in a directory tree keyed by package name
4
+
and version. When present, they are bind-mounted into the build
5
+
container and passed to opam-build as [--patch] arguments. *)
6
+
7
+
type t
8
+
9
+
val create : Fpath.t -> t
10
+
(** [create dir] creates a patch set rooted at [dir]. Patches for
11
+
package [name.version] are expected at [dir/name/version/*.patch]. *)
12
+
13
+
val has_patches : t -> OpamPackage.t -> bool
14
+
(** [has_patches t pkg] returns true if any patches exist for [pkg]. *)
15
+
16
+
val patches_for : t -> OpamPackage.t -> string list
17
+
(** [patches_for t pkg] returns the list of patch file paths for [pkg]. *)
18
+
19
+
val hash_for : t -> OpamPackage.t -> string
20
+
(** [hash_for t pkg] returns a content hash of all patches for [pkg],
21
+
used to include patches in layer hash computation. *)
22
+
23
+
val patch_args : t -> OpamPackage.t -> string
24
+
(** [patch_args t pkg] returns the [--patch] arguments for
25
+
opam-build's command line as a single string. *)
26
+
27
+
val patch_filenames : t -> OpamPackage.t -> string list
28
+
(** [patch_filenames t pkg] returns just the patch filenames
29
+
(without directory path). *)
+4
-4
opam_build/test/test_build.ml
+4
-4
opam_build/test/test_build.ml
···
209
209
Alcotest.test_case "build_hash deterministic" `Quick
210
210
(fun () ->
211
211
let h1 = Base.build_hash ~os_distribution:"debian"
212
-
~os_version:"bookworm" ~arch:"x86_64" in
212
+
~os_version:"bookworm" ~arch:"x86_64" () in
213
213
let h2 = Base.build_hash ~os_distribution:"debian"
214
-
~os_version:"bookworm" ~arch:"x86_64" in
214
+
~os_version:"bookworm" ~arch:"x86_64" () in
215
215
Alcotest.(check string) "same" h1 h2);
216
216
Alcotest.test_case "build_hash varies" `Quick
217
217
(fun () ->
218
218
let h1 = Base.build_hash ~os_distribution:"debian"
219
-
~os_version:"bookworm" ~arch:"x86_64" in
219
+
~os_version:"bookworm" ~arch:"x86_64" () in
220
220
let h2 = Base.build_hash ~os_distribution:"ubuntu"
221
-
~os_version:"24.04" ~arch:"x86_64" in
221
+
~os_version:"24.04" ~arch:"x86_64" () in
222
222
Alcotest.(check bool) "different" true (h1 <> h2));
223
223
] );
224
224
( "Dag",
+2
opam_layer/build.ml
+2
opam_layer/build.ml
+3
opam_layer/build.mli
+3
opam_layer/build.mli
+3
-2
opam_layer/build_meta.ml
+3
-2
opam_layer/build_meta.ml
···
38
38
match Hashtbl.find_opt cache h with
39
39
| Some b -> Ok b
40
40
| None ->
41
-
let layer_dir = Day11_layer.Dir.path ~os_dir h in
41
+
let layer = Day11_layer.Layer.of_hash ~os_dir h in
42
+
let layer_dir = Day11_layer.Layer.dir layer in
42
43
let* layer_meta =
43
-
Day11_layer.Meta.load Fpath.(layer_dir / "layer.json")
44
+
Day11_layer.Meta.load (Day11_layer.Layer.meta_path layer)
44
45
in
45
46
let* build_meta = load layer_dir in
46
47
let* deps = load_deps layer_meta.parent_hashes in
+10
-1
solver_pool/solver_pool.ml
+10
-1
solver_pool/solver_pool.ml
···
7
7
"_build/default/day11/solver/solver_worker.exe";
8
8
"day11-solver-worker";
9
9
] in
10
-
match List.find_opt Sys.file_exists candidates with
10
+
(* Also check PATH via 'which' *)
11
+
let from_path =
12
+
let ic = Unix.open_process_in "which day11-solver-worker 2>/dev/null" in
13
+
let path = try Some (String.trim (input_line ic)) with _ -> None in
14
+
ignore (Unix.close_process_in ic);
15
+
path
16
+
in
17
+
let all_candidates = candidates @
18
+
(match from_path with Some p -> [p] | None -> []) in
19
+
match List.find_opt Sys.file_exists all_candidates with
11
20
| Some p -> p
12
21
| None ->
13
22
let tried = String.concat ", " candidates in
+166
test/test_snapshot_service.sh
+166
test/test_snapshot_service.sh
···
1
+
#!/bin/bash
2
+
# Test snapshot service flow: simulate running day11 as a service
3
+
# across opam-repository commits spanning the OCaml 5.4.1 release,
4
+
# using the small universe profile.
5
+
#
6
+
# Tests: snapshot creation, layer caching across snapshots,
7
+
# compiler transitions, doc regeneration, and incremental behaviour.
8
+
#
9
+
# Usage: ./test_snapshot_service.sh [day11-binary]
10
+
11
+
set -e
12
+
13
+
DAY11="${1:-$(dirname "$0")/../../_build/default/day11/bin/main.exe}"
14
+
OPAM_REPO="$HOME/ocaml/opam-repository"
15
+
PROFILE_DIR="/tmp/day11-snapshot-test"
16
+
PROFILE_NAME="snapshot-test"
17
+
18
+
# Commits spanning the OCaml 5.4.1 release and subsequent package updates
19
+
# All commits are merge commits on master for deterministic state
20
+
COMMITS=(
21
+
"809faa59ae" # Just before OCaml 5.4.1 (2026-02-17)
22
+
"d10e5a9919" # OCaml 5.4.1 released (compiler change!)
23
+
"9c0b4e947c" # lwt 6.1.1 (2026-02-23)
24
+
"6185871ccd" # ppxlib 0.38.0 (2026-03-20)
25
+
"6185871ccd" # Same commit again (should be a complete no-op)
26
+
)
27
+
28
+
LABELS=(
29
+
"Before OCaml 5.4.1"
30
+
"OCaml 5.4.1 released"
31
+
"lwt 6.1.1"
32
+
"ppxlib 0.38.0"
33
+
"Repeat (no-op)"
34
+
)
35
+
36
+
# Save current state
37
+
ORIG_REF=$(git -C "$OPAM_REPO" symbolic-ref HEAD 2>/dev/null || git -C "$OPAM_REPO" rev-parse HEAD)
38
+
39
+
cleanup() {
40
+
echo ""
41
+
echo "Restoring opam-repository..."
42
+
git -C "$OPAM_REPO" checkout -q "$ORIG_REF" 2>/dev/null || true
43
+
echo "Done."
44
+
}
45
+
trap cleanup EXIT
46
+
47
+
# Ensure fork helper is linked
48
+
BINDIR=$(dirname "$DAY11")
49
+
HELPER=$(find "$BINDIR/../.." -name fork_helper.exe -type f 2>/dev/null | head -1)
50
+
[ -n "$HELPER" ] && ln -sf "$HELPER" "$BINDIR/day11-fork-helper" 2>/dev/null
51
+
52
+
echo "=========================================="
53
+
echo " Snapshot Service Test"
54
+
echo "=========================================="
55
+
echo "Binary: $DAY11"
56
+
echo "Repo: $OPAM_REPO"
57
+
echo "Profile dir: $PROFILE_DIR"
58
+
echo ""
59
+
60
+
# Clean start
61
+
sudo rm -rf "$PROFILE_DIR"
62
+
mkdir -p "$PROFILE_DIR"
63
+
64
+
# Create profile — no driver_compiler pin, auto-detect from solutions
65
+
"$DAY11" profile create \
66
+
--name "$PROFILE_NAME" \
67
+
--profile-dir "$PROFILE_DIR" \
68
+
--opam-repository "$OPAM_REPO" \
69
+
--small-universe \
70
+
--with-doc \
71
+
2>&1 | sed 's/^/ /'
72
+
echo ""
73
+
74
+
PREV_SNAPSHOT=""
75
+
76
+
for i in "${!COMMITS[@]}"; do
77
+
COMMIT="${COMMITS[$i]}"
78
+
LABEL="${LABELS[$i]}"
79
+
STEP=$((i + 1))
80
+
TOTAL=${#COMMITS[@]}
81
+
82
+
echo "=========================================="
83
+
echo " Step $STEP/$TOTAL: $LABEL"
84
+
echo " Commit: $COMMIT"
85
+
echo "=========================================="
86
+
87
+
# Checkout the commit
88
+
git -C "$OPAM_REPO" checkout -q "$COMMIT"
89
+
90
+
# Run batch
91
+
OUTPUT=$("$DAY11" batch \
92
+
--profile "$PROFILE_NAME" \
93
+
--profile-dir "$PROFILE_DIR" \
94
+
-j 4 \
95
+
2>&1) || true
96
+
97
+
# Extract key metrics
98
+
SNAPSHOT=$(echo "$OUTPUT" | grep "^Snapshot:" | awk '{print $2}')
99
+
TARGETS=$(echo "$OUTPUT" | grep "^Targets:" | awk '{print $2}')
100
+
SOLVE_CACHED=$(echo "$OUTPUT" | grep "^Solving:" | head -1 | grep -oP '^\S+\s+\K\d+(?= cached)')
101
+
SOLVE_NEED=$(echo "$OUTPUT" | grep "^Solving:" | head -1 | grep -oP '\d+(?= need)')
102
+
LAYERS_CACHED=$(echo "$OUTPUT" | grep "^Layers:" | grep -oP '\d+(?= cached)')
103
+
LAYERS_NEED=$(echo "$OUTPUT" | grep "^Layers:" | grep -oP '\d+(?= need)')
104
+
105
+
# Count doc results from output
106
+
DOC_ALL_OK=$(echo "$OUTPUT" | grep -c 'doc-all OK' || true)
107
+
LINKED=$(echo "$OUTPUT" | grep -c ': linked$' || true)
108
+
DOC_LINE=$(echo "$OUTPUT" | grep "^=== Docs:" || echo "none")
109
+
110
+
# Executor stats
111
+
EXEC_LINE=$(echo "$OUTPUT" | grep "Executor:" | tail -1 || echo "")
112
+
113
+
# Snapshot reuse check
114
+
if [ "$SNAPSHOT" = "$PREV_SNAPSHOT" ]; then
115
+
SNAP_STATUS="reused"
116
+
elif [ -n "$PREV_SNAPSHOT" ]; then
117
+
SNAP_STATUS="new"
118
+
else
119
+
SNAP_STATUS="first"
120
+
fi
121
+
122
+
echo " Snapshot: $SNAPSHOT ($SNAP_STATUS)"
123
+
echo " Targets: $TARGETS"
124
+
echo " Solver: $SOLVE_CACHED cached, $SOLVE_NEED to solve"
125
+
echo " Build layers: $LAYERS_CACHED cached, $LAYERS_NEED to build"
126
+
echo " Executor: $EXEC_LINE"
127
+
echo " Doc-all OK: $DOC_ALL_OK"
128
+
echo " Linked: $LINKED"
129
+
echo " Docs summary: $DOC_LINE"
130
+
131
+
# Verify snapshot dir
132
+
if [ -n "$SNAPSHOT" ]; then
133
+
SNAP_DIR="$PROFILE_DIR/snapshots/$PROFILE_NAME/$SNAPSHOT"
134
+
[ -d "$SNAP_DIR" ] && echo " Snapshot dir: exists" || echo " Snapshot dir: MISSING!"
135
+
fi
136
+
137
+
# Check for errors
138
+
ERRORS=$(echo "$OUTPUT" | grep -c 'FAIL\|Error\|failed' || true)
139
+
if [ "$ERRORS" -gt 0 ]; then
140
+
echo " Warnings: $ERRORS lines with FAIL/Error/failed"
141
+
echo "$OUTPUT" | grep 'FAIL\|solve failed\|Error' | head -3 | sed 's/^/ /'
142
+
fi
143
+
144
+
PREV_SNAPSHOT="$SNAPSHOT"
145
+
echo ""
146
+
done
147
+
148
+
echo "=========================================="
149
+
echo " Summary"
150
+
echo "=========================================="
151
+
152
+
# Count snapshots
153
+
N_SNAPSHOTS=$(ls -d "$PROFILE_DIR/snapshots/$PROFILE_NAME/"*/ 2>/dev/null | wc -l)
154
+
echo "Snapshots created: $N_SNAPSHOTS (expected 4 — step 5 reuses step 4)"
155
+
156
+
# Count layers in shared cache
157
+
CACHE_OS="$PROFILE_DIR/cache/debian-bookworm-x86_64"
158
+
if [ -d "$CACHE_OS" ]; then
159
+
N_LAYERS=$(ls "$CACHE_OS" | grep -cE '^[0-9a-f]{12}$' || true)
160
+
echo "Layers in shared cache: $N_LAYERS"
161
+
HTML_COUNT=$(find "$CACHE_OS/html" -name '*.html' 2>/dev/null | wc -l)
162
+
echo "HTML files: $HTML_COUNT"
163
+
fi
164
+
165
+
echo ""
166
+
echo "Done."