forked from
anil.recoil.org/monopam-myspace
My aggregated monorepo of OCaml code, automaintained
Use overlayfs multi-lower for layer stacking, fallback to merge
Pass each dep layer's fs/ as a separate overlayfs lower directory
instead of cp-merging into one dir. Zero copy, instant mount.
Falls back to cp-merge when the lowerdir mount options string would
exceed 4K (kernel page size limit), which happens with ~50+ deps.
212/281 layers used multi-lower in testing. Eliminates merge overhead
for most packages.
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
+31
-23
+31
-23
day11/build/run_in_layers.ml
+31
-23
day11/build/run_in_layers.ml
···
11
11
("HOME", "/home/opam");
12
12
]
13
13
14
-
let timed name f =
14
+
let _timed name f =
15
15
let t0 = Unix.gettimeofday () in
16
16
let r = f () in
17
17
let elapsed = Unix.gettimeofday () -. t0 in
···
49
49
let p = Fpath.(tmp / name) in
50
50
Bos.OS.Dir.create ~path:true p |> ignore; p
51
51
in
52
-
let lower = Fpath.(temp_dir / "lower") in
53
52
let upper = Fpath.(temp_dir / "upper") in
54
53
let work = Fpath.(temp_dir / "work") in
55
54
let merged = Fpath.(temp_dir / "merged") in
56
-
List.iter mkdir [ lower; upper; work; merged ];
55
+
let lower = Fpath.(temp_dir / "lower") in
56
+
List.iter mkdir [ upper; work; merged ];
57
+
(* Use overlayfs multi-lower when possible (zero copy, instant).
58
+
Fall back to cp-merge when there are too many layers — the mount
59
+
options string is limited to one page (4096 bytes). *)
60
+
let all_layer_fs_dirs = List.filter_map (fun dir ->
61
+
let fs = Fpath.(dir / "fs") in
62
+
if Bos.OS.Dir.exists fs |> Result.get_ok then Some fs else None
63
+
) build_dirs in
64
+
let lowerdir_len = List.fold_left (fun acc fs ->
65
+
acc + String.length (Fpath.to_string fs) + 1
66
+
) 0 (all_layer_fs_dirs @ [ base_fs ]) in
67
+
let use_merge = lowerdir_len > 3500 in
68
+
let layer_fs_dirs =
69
+
if not use_merge then all_layer_fs_dirs
70
+
else begin
71
+
mkdir lower;
72
+
timed_to (Printf.sprintf "stack.merge (%d build layers)"
73
+
(List.length build_dirs)) t_merge (fun () ->
74
+
Day11_layer.Stack.merge env ~layer_dirs:build_dirs ~target:lower)
75
+
|> ignore;
76
+
[ lower ]
77
+
end
78
+
in
57
79
let cleanup_internals () =
58
-
timed "cleanup lower" (fun () ->
59
-
ignore (Day11_exec.Sudo.rm_rf env lower));
80
+
if use_merge then
81
+
ignore (Day11_exec.Sudo.rm_rf env lower);
60
82
ignore (Day11_exec.Sudo.rm_rf env work);
61
83
ignore (Day11_exec.Sudo.rm_rf env merged);
62
84
ignore (Bos.OS.File.delete Fpath.(temp_dir / "config.json"))
63
85
in
64
-
(* Merge only build layers into lower — base stays as separate
65
-
overlay lower to avoid hardlink-copying 50k+ base image files *)
66
-
let* () =
67
-
if build_dirs = [] then Ok ()
68
-
else timed_to (Printf.sprintf "stack.merge (%d build layers)"
69
-
(List.length build_dirs)) t_merge (fun () ->
70
-
Day11_layer.Stack.merge env ~layer_dirs:build_dirs ~target:lower)
71
-
in
72
-
(* Dump switch-state from both build layers and base image.
73
-
The base image is a separate overlay lower so its packages
74
-
(e.g. base-unix) aren't in the merged lower dir. *)
86
+
(* Dump switch-state from build layers and base image *)
75
87
timed_to "dump_state" t_dump (fun () ->
76
88
let switch_rel = Fpath.(v "home" / "opam" / ".opam" / switch
77
89
/ ".opam-switch") in
···
79
91
let packages_dirs = List.filter_map (fun dir ->
80
92
let p = Fpath.(dir // packages_rel) in
81
93
if Bos.OS.Dir.exists p |> Result.get_ok then Some p else None
82
-
) [ lower; base_fs ] in
94
+
) (layer_fs_dirs @ [ base_fs ]) in
83
95
if packages_dirs <> [] then begin
84
96
let state_dir = Fpath.(upper // switch_rel) in
85
97
mkdir state_dir;
···
93
105
if Bos.OS.Dir.exists home_dir |> Result.get_ok then
94
106
ignore (Day11_exec.Sudo.run env
95
107
Bos.Cmd.(v "chown" % "-R" % uid_gid % Fpath.to_string home_dir)));
96
-
(* Mount overlay *)
97
-
(* Mount with build layers merged + base as separate lower *)
98
-
let overlay_lowers =
99
-
if build_dirs = [] then [ base_fs ]
100
-
else [ lower; base_fs ]
101
-
in
108
+
(* Mount overlay with all layers as separate lowers *)
109
+
let overlay_lowers = layer_fs_dirs @ [ base_fs ] in
102
110
let* () = timed_to "overlay mount" t_mount (fun () ->
103
111
Day11_container.Overlay.mount env
104
112
~lower:overlay_lowers ~upper ~work ~target:merged)