this repo has no description
1let src_log = Logs.Src.create "day11.layer.stack" ~doc:"Layer stacking"
2module Log = (val Logs.src_log src_log)
3
4let plan_lowerdir ~available ~merged_overhead ~entry_cost layer_dirs =
5 let total_cost =
6 List.fold_left (fun acc d -> acc + entry_cost d) 0 layer_dirs
7 in
8 (* Fast path: every layer fits as its own lowerdir, no merge needed. *)
9 if total_cost <= available then (layer_dirs, [])
10 else begin
11 (* Walk the list taking layers for the separate bucket as long
12 as we stay within (available - merged_overhead). Once we'd
13 overflow, the rest of the list goes to the merged bucket. *)
14 let target = available - merged_overhead in
15 let rec aux acc_cost kept = function
16 | [] -> (List.rev kept, [])
17 | d :: rest ->
18 let c = entry_cost d in
19 if acc_cost + c <= target then
20 aux (acc_cost + c) (d :: kept) rest
21 else
22 (List.rev kept, d :: rest)
23 in
24 aux 0 [] layer_dirs
25 end
26
27let merge env ~layer_dirs ~target =
28 (* Collect all layer fs/ dirs that exist *)
29 let fs_dirs = List.filter_map (fun layer_dir ->
30 let fs = Fpath.(layer_dir / "fs") in
31 if Bos.OS.Dir.exists fs |> Result.get_ok then
32 Some (Fpath.to_string fs)
33 else begin
34 Log.debug (fun m ->
35 m "Skipping %a (no fs/ subdir)" Fpath.pp layer_dir);
36 None
37 end
38 ) layer_dirs in
39 if fs_dirs = [] then Ok ()
40 else begin
41 Log.info (fun m -> m "Merging %d layer fs dirs into %a"
42 (List.length fs_dirs) Fpath.pp target);
43 (* Batch all cp commands into a single sudo call to avoid
44 spawning hundreds of sudo processes for large dep lists.
45 Use ; instead of && so one failure doesn't skip the rest. *)
46 let target_s = Fpath.to_string target in
47 let cmds = List.map (fun fs ->
48 Printf.sprintf "cp -n --archive --no-dereference --recursive --link --no-target-directory %s %s"
49 (Filename.quote fs) (Filename.quote target_s)
50 ) fs_dirs in
51 let script = "r=0; " ^
52 String.concat " " (List.map (fun c -> c ^ " || r=1;") cmds)
53 ^ " exit $r" in
54 let result =
55 Day11_exec.Sudo.run env
56 Bos.Cmd.(v "bash" % "-c" % script)
57 in
58 match result with
59 | Ok _ -> Ok ()
60 | Error _ as e -> e
61 end