this repo has no description
1(** batch command: solve, build, and optionally generate docs *)
2
3open Cmdliner
4module Build = Day11_opam_layer.Build
5module Tool = Day11_opam_layer.Tool
6module Layer = Day11_layer.Layer
7type build = Build.t
8type tool = Tool.t
9
10
11
12let cleanup_stale_mounts () =
13 (* Unmount and remove any leaked day11_run_* overlay mounts from
14 previous runs that were killed without cleanup *)
15 let tmp = Filename.get_temp_dir_name () in
16 let entries = try Sys.readdir tmp |> Array.to_list with _ -> [] in
17 let stale = List.filter (fun name ->
18 String.length name > 10 &&
19 String.sub name 0 10 = "day11_run_"
20 ) entries in
21 if stale <> [] then begin
22 Printf.printf "Cleaning up %d stale temp dirs...\n%!" (List.length stale);
23 List.iter (fun name ->
24 let merged = Filename.concat (Filename.concat tmp name) "merged" in
25 ignore (Sys.command (Printf.sprintf "sudo umount %s 2>/dev/null" merged));
26 ) stale;
27 ignore (Sys.command (Printf.sprintf "sudo rm -rf %s"
28 (String.concat " " (List.map (fun name ->
29 Filename.concat tmp name) stale))))
30 end
31
32let run profile_name profile_dir np
33 solve_only dry_run rebuild_failed rebuild_base fake_build target_override =
34 cleanup_stale_mounts ();
35 let profile, paths = match Common.load_profile ~profile_dir ~name:profile_name with
36 | Ok x -> x | Error (`Msg e) -> Printf.eprintf "Error: %s\n" e; exit 1
37 in
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;
46 let cache_dir = paths.cache_dir in
47 let os_dir = paths.os_dir in
48 let ocaml_version = Common.parse_ocaml_version profile.compiler in
49 let driver_compiler = if profile.driver_compiler = ""
50 then None
51 else Some (OpamPackage.of_string profile.driver_compiler) in
52 let opam_repositories = profile.opam_repositories in
53 let with_doc = profile.with_doc in
54 let os_distribution = profile.os_distribution in
55 let os_version = profile.os_version in
56 let arch = profile.arch in
57 let patches_dir = profile.patches_dir in
58 let opam_build_repo = profile.opam_build_repo in
59 let extra_pins = profile.extra_pins in
60 let odoc_repo = profile.odoc_repo in
61 let jtw_repo = if profile.with_jtw then profile.jtw_repo else None in
62 let small_universe, all_versions, target = match target_override with
63 | Some t ->
64 (* CLI target overrides the profile's target mode *)
65 (false, false, Some t)
66 | None ->
67 let sm = profile.target_mode = Day11_batch.Profile.Small_universe in
68 let av = profile.target_mode = Day11_batch.Profile.All_versions in
69 let tgt = match profile.target_mode with
70 | Day11_batch.Profile.Packages (pkg :: _) -> Some pkg
71 | _ -> None
72 in
73 (sm, av, tgt)
74 in
75 let git_packages, repos_with_shas, opam_env =
76 Common.setup_solver opam_repositories in
77 let targets = Day11_batch.Targets.resolve ~small:small_universe ~all_versions git_packages target in
78 Printf.printf "Targets: %d packages\n%!" (List.length targets);
79 (* Snapshot — deterministic dir keyed by repo HEADs *)
80 let snapshot = Day11_batch.Snapshot.current profile in
81 let snapshot_dir = Fpath.(paths.snapshots_base / snapshot.key) in
82 ignore (Bos.OS.Dir.create ~path:true snapshot_dir);
83 ignore (Day11_batch.Snapshot.save snapshot_dir snapshot);
84 Printf.printf "Snapshot: %s\n%!" snapshot.key;
85 (* Start run log *)
86 Day11_lib.Run_log.set_log_base_dir (Fpath.to_string snapshot_dir);
87 let run_log = Day11_lib.Run_log.start_run () in
88 Day11_lib.Run_log.write_plan run_log ~repos_with_shas
89 ~n_targets:(List.length targets)
90 ~ocaml_version:(Option.map OpamPackage.to_string ocaml_version)
91 ~with_doc ~all_versions ~small_universe;
92 (match ocaml_version with
93 | Some v -> Printf.printf "Compiler: %s\n%!" (OpamPackage.to_string v)
94 | None -> ());
95 (* Solve — load cached solutions where possible *)
96 let solutions_dir = Day11_batch.Snapshot.solutions_dir snapshot_dir in
97 Bos.OS.Dir.create ~path:true solutions_dir |> ignore;
98 let cached = ref 0 in
99 let need_solve = List.filter (fun target ->
100 let cache_file = Fpath.(solutions_dir /
101 (OpamPackage.to_string target ^ ".json")) in
102 if Sys.file_exists (Fpath.to_string cache_file) then begin
103 incr cached; false
104 end else true
105 ) targets in
106 Printf.printf "Solving: %d cached, %d need solving (%d workers)...\n%!"
107 !cached (List.length need_solve) np;
108 let results = Day11_solver_pool.Solver_pool.solve_many
109 ?ocaml_version ~np ~repos:repos_with_shas need_solve in
110 (* Retry failed solves with older versions (useful for overlays that
111 pin transitive deps to specific versions) *)
112 let results, targets =
113 if not small_universe then (results, targets)
114 else
115 let new_results = ref [] in
116 let new_targets = ref [] in
117 let solved_names = Hashtbl.create 16 in
118 (* First pass: collect successes *)
119 List.iter (fun (target, result) ->
120 match result with
121 | Ok _ ->
122 new_results := (target, result) :: !new_results;
123 Hashtbl.replace solved_names
124 (OpamPackage.name target) target
125 | Error _ -> ()
126 ) results;
127 (* Second pass: retry failures *)
128 List.iter (fun (target, result) ->
129 match result with
130 | Ok _ -> ()
131 | Error _ ->
132 let name = OpamPackage.Name.to_string (OpamPackage.name target) in
133 let candidates = Day11_batch.Targets.pick_latest_version git_packages name in
134 let older = List.filter (fun pkg ->
135 OpamPackage.Version.compare (OpamPackage.version pkg)
136 (OpamPackage.version target) < 0
137 ) candidates in
138 if older = [] then
139 new_results := (target, result) :: !new_results
140 else begin
141 Printf.printf " Retrying %s with older versions...\n%!" name;
142 let retries = Day11_solver_pool.Solver_pool.solve_many
143 ?ocaml_version ~np:1 ~repos:repos_with_shas older in
144 match List.find_opt (fun (_, r) -> Result.is_ok r) retries with
145 | Some hit ->
146 Printf.printf " %s -> %s\n%!"
147 name (OpamPackage.to_string (fst hit));
148 new_results := hit :: !new_results;
149 Hashtbl.replace solved_names
150 (OpamPackage.name target) (fst hit)
151 | None ->
152 new_results := (target, result) :: !new_results
153 end
154 ) results;
155 (* Update targets to use the versions that actually solved *)
156 List.iter (fun target ->
157 match Hashtbl.find_opt solved_names (OpamPackage.name target) with
158 | Some pkg -> new_targets := pkg :: !new_targets
159 | None -> new_targets := target :: !new_targets
160 ) targets;
161 (List.rev !new_results, List.rev !new_targets)
162 in
163 (* Save new solutions *)
164 List.iter (fun (target, result) ->
165 let entry = match result with
166 | Ok result ->
167 Day11_batch.Incremental_solver.Cached_solution {
168 package = target; result }
169 | Error (msg, examined) ->
170 Day11_batch.Incremental_solver.Cached_failure {
171 package = target; error = msg; examined }
172 in
173 ignore (Day11_batch.Incremental_solver.save
174 Fpath.(solutions_dir / (OpamPackage.to_string target ^ ".json"))
175 entry)
176 ) results;
177 (* Load all solutions (cached + new) *)
178 let solutions = List.filter_map (fun target ->
179 let cache_file = Fpath.(solutions_dir /
180 (OpamPackage.to_string target ^ ".json")) in
181 match Day11_batch.Incremental_solver.load cache_file with
182 | Ok (Day11_batch.Incremental_solver.Cached_solution { result; _ }) ->
183 Some (target, result)
184 | _ -> None
185 ) targets in
186 (* Extract build_deps for consumers that don't need doc_deps *)
187 let build_solutions = List.map (fun (t, r) ->
188 (t, (r : Day11_solution.Solve_result.t).build_deps)) solutions in
189 let n_solved = List.length solutions in
190 let n_failed = List.length targets - n_solved in
191 Printf.printf "Solved: %d/%d (%d failed)\n%!" n_solved (List.length targets) n_failed;
192 Day11_lib.Run_log.write_solve run_log ~n_solved ~n_failed;
193 if solve_only then begin
194 Printf.printf "Solutions cached in %s\n%!" (Fpath.to_string solutions_dir);
195 0
196 end else
197 let find_opam = Day11_opam.Git_packages.find_package git_packages in
198 let patches = Option.map (fun dir ->
199 Day11_opam_build.Patches.create (Fpath.v dir)) patches_dir in
200 (* Delete base image early if --rebuild-base, before loading *)
201 if rebuild_base then begin
202 let base_dir = Fpath.(cache_dir / "base") in
203 Printf.printf "Deleting base image and all build layers for rebuild...\n%!";
204 (* Both dirs have root-owned files — go straight to sudo rm -rf *)
205 ignore (Sys.command
206 (Printf.sprintf "sudo rm -rf %s %s"
207 (Fpath.to_string base_dir) (Fpath.to_string os_dir)))
208 end;
209 let base_opt = Day11_opam_build.Base.load_cached ~cache_dir
210 ~os_distribution ~os_version in
211 let base_hash = Day11_opam_build.Base.build_hash
212 ~os_distribution ~os_version ~arch ?digest:profile.base_image_digest () in
213 (* Build DAG — no Eio needed *)
214 let cache = Day11_opam_build.Hash_cache.create ~find_opam ?patches () in
215 let nodes = Day11_opam_build.Dag.build_dag cache
216 ~base_hash build_solutions in
217 Printf.printf "DAG: %d unique build nodes\n%!" (List.length nodes);
218 (* Delete failed layers if --rebuild-failed *)
219 if rebuild_failed then begin
220 let root_deleted = ref 0 in
221 let cascade_deleted = ref 0 in
222 List.iter (fun (node : Day11_opam_layer.Build.t) ->
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
226 | Ok { exit_status; failed_dep; _ } when exit_status <> 0 ->
227 ignore (Bos.OS.Path.delete ~recurse:true (Layer.dir layer));
228 if failed_dep = None then incr root_deleted
229 else incr cascade_deleted
230 | _ -> ()
231 ) nodes;
232 if !root_deleted + !cascade_deleted > 0 then
233 Printf.printf "Deleted %d root failures + %d cascade failures for rebuild\n%!"
234 !root_deleted !cascade_deleted
235 end;
236 (* Check which layers already exist *)
237 let n_cached = List.length (List.filter (fun (node : Day11_opam_layer.Build.t) ->
238 Layer.exists (Build.layer ~os_dir node)
239 ) nodes) in
240 let n_need_build = List.length nodes - n_cached in
241 Printf.printf "Layers: %d cached, %d need building\n%!" n_cached n_need_build;
242 Day11_lib.Run_log.write_dag run_log ~n_build:(List.length nodes)
243 ~n_cached ~n_need_build;
244 if dry_run then begin
245 if n_need_build > 0 then begin
246 Printf.printf "\nLayers to build:\n";
247 List.iter (fun (node : Day11_opam_layer.Build.t) ->
248 if not (Layer.exists (Build.layer ~os_dir node)) then
249 Printf.printf " %s (%d deps)\n"
250 (OpamPackage.to_string node.pkg) (List.length node.deps)
251 ) nodes
252 end;
253 0
254 end else begin
255 (* === Build phase (needs Eio, base image, containers) === *)
256 Common.with_eio @@ fun env ->
257 (* Build opam-build separately if needed *)
258 if rebuild_base then begin
259 let bin = Fpath.(cache_dir / "opam-build-bin") in
260 ignore (Bos.OS.File.delete bin)
261 end;
262 let opam_build_repo_fpath = Option.map Fpath.v opam_build_repo in
263 (match Day11_opam_build.Base.build_opam_build env ~cache_dir ~arch
264 ?opam_build_repo:opam_build_repo_fpath () with
265 | Ok path ->
266 Printf.printf "opam-build: %s\n%!" (Fpath.to_string path)
267 | Error (`Msg e) ->
268 Printf.eprintf "opam-build build failed: %s\n%!" e;
269 exit 1);
270 let base = match base_opt with
271 | Some b -> b
272 | None ->
273 Printf.printf "Building base image...\n%!";
274 let uid = Unix.getuid () and gid = Unix.getgid () in
275 (match Day11_opam_build.Base.build env ~cache_dir
276 ~os_distribution ~os_version ~arch
277 ~opam_repositories:(List.map Fpath.v opam_repositories) ~uid ~gid
278 ?digest:profile.base_image_digest () with
279 | Ok base -> base
280 | Error (`Msg e) ->
281 Printf.eprintf "Base image build failed: %s\n%!" e;
282 exit 1)
283 in
284 let benv = Day11_opam_build.Types.make_build_env ~base ~os_dir () in
285 Day11_opam_build.Types.ensure_dirs benv;
286 (* Create merged opam-repository and mount into containers —
287 picks up changes without rebuilding the base image *)
288 let merged_repo_dir = Fpath.(snapshot_dir / "merged-repo") in
289 ignore (Day11_exec.Sudo.rm_rf env merged_repo_dir);
290 Bos.OS.Dir.create ~path:true merged_repo_dir |> ignore;
291 List.iteri (fun i repo ->
292 let src = Fpath.v repo in
293 if i = 0 then
294 ignore (Day11_exec.Tree.copy ~source:src ~target:merged_repo_dir)
295 else
296 (* Overlay: copy packages/ from later repos, overwriting *)
297 let src_pkgs = Fpath.(src / "packages") in
298 if Bos.OS.Dir.exists src_pkgs |> Result.get_ok then
299 ignore (Sys.command (Printf.sprintf "cp -a %s/* %s/packages/"
300 (Fpath.to_string src_pkgs) (Fpath.to_string merged_repo_dir)))
301 ) opam_repositories;
302 let repo_mount = Day11_container.Mount.bind_rw
303 ~src:(Fpath.to_string merged_repo_dir)
304 "/home/opam/.opam/repo/default" in
305 let base_mounts =
306 [ repo_mount ] @
307 (match Day11_opam_build.Base.opam_build_mount ~cache_dir with
308 | Some m -> [ m ] | None -> [])
309 in
310 (* Bless *)
311 let blessing_maps = Day11_batch.Blessing.compute_blessings build_solutions in
312 (* Build function for the unified DAG *)
313 let packages_dir = Day11_batch.Snapshot.packages_dir snapshot_dir in
314 ignore (Bos.OS.Dir.create ~path:true packages_dir);
315 let fake_strategy pkg =
316 let pkg_str = OpamPackage.to_string pkg in
317 { Day11_opam_build.Types.cmd =
318 Printf.sprintf "echo 'fake-build %s'" pkg_str;
319 cleanup = Day11_opam_build.Build_layer.opam_build_cleanup }
320 in
321 (* Accumulate build outcomes for Summary *)
322 let build_outcomes_lock = Mutex.create () in
323 let build_outcomes : Day11_batch.Summary.build_outcome list ref = ref [] in
324 let record_build_outcome (node : Day11_opam_layer.Build.t) success =
325 let blessed =
326 List.exists (fun (_target, map) ->
327 Day11_batch.Blessing.is_blessed map node.pkg
328 ) blessing_maps
329 in
330 let log_file =
331 let dir = Day11_opam_layer.Build.dir ~os_dir node in
332 let p = Fpath.(dir / "build.log") in
333 if Sys.file_exists (Fpath.to_string p) then Some p else None
334 in
335 let outcome : Day11_batch.Summary.build_outcome = {
336 pkg = node.pkg;
337 build_hash = node.hash;
338 success;
339 log_file;
340 blessed;
341 } in
342 Mutex.lock build_outcomes_lock;
343 build_outcomes := outcome :: !build_outcomes;
344 Mutex.unlock build_outcomes_lock
345 in
346 let build_one (node : Day11_opam_layer.Build.t) =
347 let strategy =
348 if fake_build then Some (fake_strategy node.pkg)
349 else None
350 in
351 let pkg_str = OpamPackage.to_string node.pkg in
352 let on_extract ~layer_dir ~success:_ =
353 let installed_libs =
354 Day11_opam_layer.Installed_files.scan_libs ~layer_dir in
355 let installed_docs =
356 Day11_opam_layer.Installed_files.scan_docs ~layer_dir in
357 let bm : Day11_opam_layer.Build_meta.t = {
358 package = pkg_str;
359 deps = List.map (fun (d : Day11_opam_layer.Build.t) ->
360 OpamPackage.to_string d.pkg) node.deps;
361 installed_libs;
362 installed_docs;
363 patches = (match patches with
364 | Some p -> Day11_opam_build.Patches.patch_filenames p node.pkg
365 | None -> []);
366 } in
367 ignore (Day11_opam_layer.Build_meta.save layer_dir bm)
368 in
369 match Day11_opam_build.Build_layer.build env benv ?patches
370 ~mounts:base_mounts ~on_extract node ?strategy () with
371 | Day11_opam_build.Types.Success _ ->
372 let layer_name = Day11_opam_layer.Build.dir_name node in
373 ignore (Day11_layer.Symlinks.ensure
374 ~packages_dir ~id:pkg_str ~layer_name);
375 record_build_outcome node true;
376 true
377 | _ ->
378 record_build_outcome node false;
379 false
380 in
381 (* Build + Docs (unified pipeline when --with-doc) *)
382 if with_doc then begin
383 Day11_doc.Generate.build_tools_and_run env benv ~np ~os_dir
384 ~packages:git_packages ~repos:repos_with_shas ~opam_env
385 ~mounts:base_mounts
386 ?driver_compiler ~odoc_repo ~build_one
387 ~opam_repositories ~cache ~run_log
388 ~nodes ~solutions ~blessing_maps ()
389 end
390 else begin
391 (* Build only — no docs *)
392 let is_cached node =
393 let layer = Build.layer ~os_dir node in
394 if not (Layer.exists layer) then
395 Day11_opam_build.Dag_executor.Not_cached
396 else begin
397 Day11_layer.Last_used.touch (Layer.dir layer);
398 match Day11_layer.Meta.load (Layer.meta_path layer) with
399 | Ok meta ->
400 let success = meta.exit_status = 0 in
401 record_build_outcome node success;
402 if success then Day11_opam_build.Dag_executor.Cached_ok
403 else Day11_opam_build.Dag_executor.Cached_fail
404 | Error _ ->
405 record_build_outcome node false;
406 Day11_opam_build.Dag_executor.Cached_fail
407 end
408 in
409 let cascaded_set : (string, unit) Hashtbl.t = Hashtbl.create 256 in
410 Day11_opam_build.Dag_executor.execute env ~np ~is_cached
411 ~on_complete:(fun ~stats node success ->
412 let open Day11_opam_build.Dag_executor in
413 if Hashtbl.mem cascaded_set node.hash then
414 ()
415 else begin
416 let status = if success then "ok" else "fail" in
417 let layer = Fpath.to_string
418 (Day11_opam_layer.Build.dir ~os_dir node) in
419 Day11_lib.Run_log.log_build_result run_log
420 ~pkg:(OpamPackage.to_string node.pkg)
421 ~hash:node.hash ~status ~failed_dep:None
422 ~kind:"build" ~layer_dir:layer ();
423 if not success then
424 Printf.printf "[%d/%d, %d ok, %d failed, %d cascade] FAIL: %s\n%!"
425 stats.completed stats.total stats.ok stats.failed
426 stats.cascaded (OpamPackage.to_string node.pkg)
427 else if stats.completed mod 100 = 0 then
428 Printf.printf "[%d/%d, %d ok, %d failed, %d cascade] %s\n%!"
429 stats.completed stats.total stats.ok stats.failed
430 stats.cascaded (OpamPackage.to_string node.pkg)
431 end)
432 ~on_cascade:(fun ~failed ~failed_dep ->
433 Hashtbl.replace cascaded_set failed.hash ();
434 (* Write a skeleton layer.json so re-runs skip this node *)
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
438 let meta : Day11_layer.Meta.t = {
439 exit_status = 1;
440 parent_hashes = [];
441 uid = benv.uid; gid = benv.gid;
442 base_hash = benv.base.hash;
443 disk_usage = 0;
444 timing = Day11_layer.Meta.empty_timing;
445 created_at = "";
446 failed_dep = Some (Day11_opam_layer.Build.dir_name failed_dep);
447 } in
448 ignore (Day11_layer.Meta.save (Layer.meta_path layer) meta)
449 end;
450 (* Create package symlink so the failure is discoverable *)
451 let pkg_str = OpamPackage.to_string failed.pkg in
452 let layer_name = Day11_opam_layer.Build.dir_name failed in
453 ignore (Day11_layer.Symlinks.ensure
454 ~packages_dir ~id:pkg_str ~layer_name);
455 Day11_lib.Run_log.log_build_result run_log
456 ~pkg:(OpamPackage.to_string failed.pkg)
457 ~hash:failed.hash ~status:"cascade"
458 ~failed_dep:(Some (OpamPackage.to_string failed_dep.pkg))
459 ~kind:"build" ();
460 record_build_outcome failed false)
461 nodes build_one
462 end;
463 (* JTW *)
464 (match jtw_repo with
465 | Some dir ->
466 let output = Fpath.to_string Fpath.(cache_dir / "jtw-output") in
467 Day11_jtw.Build_tools.build_and_run env benv ~np ~os_dir
468 ~packages:git_packages ~repos:repos_with_shas ~mounts:[repo_mount]
469 ~extra_repo_dirs:extra_pins ~repo_dir:dir ~output
470 ~nodes ~solutions:build_solutions
471 | None -> ());
472 (* Write final summary via Summary module *)
473 Day11_lib.Run_log.close_build_log ();
474 let compiler = match ocaml_version with
475 | Some v -> OpamPackage.to_string v
476 | None -> "unknown"
477 in
478 let results : Day11_batch.Summary.results = {
479 builds = !build_outcomes;
480 docs = [];
481 targets;
482 } in
483 ignore (Day11_batch.Summary.finish ~snapshot_dir ~packages_dir
484 ~run_info:run_log ~compiler results);
485 0
486 end
487
488let solve_only_term =
489 let doc = "Solve only — cache solutions and exit without building" in
490 Arg.(value & flag & info [ "solve-only" ] ~doc)
491
492let dry_run_term =
493 let doc = "Show what would be built without actually building" in
494 Arg.(value & flag & info [ "dry-run" ] ~doc)
495
496let rebuild_failed_term =
497 let doc = "Delete failed layers and rebuild them" in
498 Arg.(value & flag & info [ "rebuild-failed" ] ~doc)
499
500let rebuild_base_term =
501 let doc = "Delete and rebuild the base image (use when repos or opam-build change)" in
502 Arg.(value & flag & info [ "rebuild-base" ] ~doc)
503
504let fake_build_term =
505 let doc = "Replace opam-build with a trivial echo command (for testing)" in
506 Arg.(value & flag & info [ "fake-build" ] ~doc)
507
508let target_term =
509 let doc = "Optional target package (overrides profile's target mode)" in
510 Arg.(value & pos 0 (some string) None & info [] ~docv:"TARGET" ~doc)
511
512let cmd =
513 let info = Cmd.info "batch" ~doc:"Solve, build, and document packages" in
514 let term = Term.(const run $ Common.profile_term $ Common.profile_dir_term
515 $ Common.np_term
516 $ solve_only_term $ dry_run_term
517 $ rebuild_failed_term $ rebuild_base_term $ fake_build_term
518 $ target_term) in
519 Cmd.v info term