forked from
anil.recoil.org/monopam-myspace
My aggregated monorepo of OCaml code, automaintained
Add comprehensive timing to layer metadata
Each layer.json now includes a timing record with per-phase durations:
merge, dump_state, chown, overlay_mount, runc_run, overlay_umount,
cleanup, extract, total. All times in seconds.
Enables profiling where time is spent: container setup overhead vs
actual package build.
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
+80
-15
+6
-3
day11/build/build_layer.ml
+6
-3
day11/build/build_layer.ml
···
42
42
(** Extract the build result: move upper to layer, scan files, write metadata. *)
43
43
let extract_layer env ~layer_dir ~layer_json ~upper ~pkg_str
44
44
~(node : build) ~packages_dir ~(benv : Types.build_env)
45
-
?patches (run : Day11_exec.Run.t) =
45
+
?patches ~timing (run : Day11_exec.Run.t) =
46
46
let layer_name = build_dir_name node in
47
47
let exit_code = match run.status with
48
48
| `Exited n -> n
···
80
80
installed_libs; installed_docs;
81
81
patches = patch_names; failed_dep = None;
82
82
disk_usage;
83
+
timing;
83
84
created_at = Day11_layer.Layer_meta.now_iso8601 ();
84
85
} in
85
86
let _ = Day11_layer.Layer_meta.save_build layer_json meta in
···
155
156
let all_mounts = repo_mounts @ patch_mounts @ mounts in
156
157
match Run_in_layers.run env ~base ~build_dirs:dep_dirs ~uid ~gid
157
158
~mounts:all_mounts strategy.cmd with
158
-
| Ok (run, upper) ->
159
+
| Ok (run, upper, timing) ->
159
160
strategy.cleanup env upper;
160
161
let _exit_code =
161
162
extract_layer env ~layer_dir ~layer_json ~upper
162
-
~pkg_str ~node ~packages_dir ~benv ?patches run in
163
+
~pkg_str ~node ~packages_dir ~benv ?patches
164
+
~timing run in
163
165
ignore (Day11_exec.Sudo.rm_rf env (Fpath.parent upper));
164
166
Ok ()
165
167
| Error (`Msg e) ->
···
171
173
base_hash = benv.base.hash;
172
174
installed_libs = []; installed_docs = []; patches = []; failed_dep = None;
173
175
disk_usage = 0;
176
+
timing = Day11_layer.Layer_meta.empty_timing;
174
177
created_at = Day11_layer.Layer_meta.now_iso8601 ();
175
178
} in
176
179
let _ = Day11_layer.Layer_meta.save_build layer_json fail_meta in
+34
-9
day11/build/run_in_layers.ml
+34
-9
day11/build/run_in_layers.ml
···
19
19
Log.info (fun m -> m "%s: %.3fs" name elapsed);
20
20
r
21
21
22
+
(** Like [timed] but also stores elapsed time in a ref *)
23
+
let timed_to name dst f =
24
+
let t0 = Unix.gettimeofday () in
25
+
let r = f () in
26
+
let elapsed = Unix.gettimeofday () -. t0 in
27
+
dst := elapsed;
28
+
if elapsed > 0.1 then
29
+
Log.info (fun m -> m "%s: %.3fs" name elapsed);
30
+
r
31
+
22
32
let run env ~(base : Day11_layer.Layer_type.base)
23
33
~build_dirs
24
34
~uid ~gid ?(mounts = []) cmd =
35
+
let t_total = Unix.gettimeofday () in
36
+
let t_merge = ref 0. in
37
+
let t_dump = ref 0. in
38
+
let t_chown = ref 0. in
39
+
let t_mount = ref 0. in
40
+
let t_runc = ref 0. in
41
+
let t_umount = ref 0. in
42
+
let t_cleanup = ref 0. in
25
43
let base_fs = Fpath.add_seg base.dir "fs" in
26
44
let switch = Types.switch in
27
45
let temp_dir =
···
47
65
overlay lower to avoid hardlink-copying 50k+ base image files *)
48
66
let* () =
49
67
if build_dirs = [] then Ok ()
50
-
else timed (Printf.sprintf "stack.merge (%d build layers)"
51
-
(List.length build_dirs)) (fun () ->
68
+
else timed_to (Printf.sprintf "stack.merge (%d build layers)"
69
+
(List.length build_dirs)) t_merge (fun () ->
52
70
Day11_layer.Stack.merge env ~layer_dirs:build_dirs ~target:lower)
53
71
in
54
72
(* Dump switch-state from both build layers and base image.
55
73
The base image is a separate overlay lower so its packages
56
74
(e.g. base-unix) aren't in the merged lower dir. *)
57
-
timed "dump_state" (fun () ->
75
+
timed_to "dump_state" t_dump (fun () ->
58
76
let switch_rel = Fpath.(v "home" / "opam" / ".opam" / switch
59
77
/ ".opam-switch") in
60
78
let packages_rel = Fpath.(switch_rel / "packages") in
···
69
87
Fpath.(state_dir / "switch-state") |> ignore
70
88
end);
71
89
(* Chown upper for overlay permissions *)
72
-
timed "chown upper" (fun () ->
90
+
timed_to "chown upper" t_chown (fun () ->
73
91
let uid_gid = Printf.sprintf "%d:%d" uid gid in
74
92
let home_dir = Fpath.(upper / "home") in
75
93
if Bos.OS.Dir.exists home_dir |> Result.get_ok then
···
81
99
if build_dirs = [] then [ base_fs ]
82
100
else [ lower; base_fs ]
83
101
in
84
-
let* () = timed "overlay mount" (fun () ->
102
+
let* () = timed_to "overlay mount" t_mount (fun () ->
85
103
Day11_container.Overlay.mount env
86
104
~lower:overlay_lowers ~upper ~work ~target:merged)
87
105
in
···
89
107
let run_result =
90
108
Fun.protect
91
109
~finally:(fun () ->
92
-
timed "overlay umount" (fun () ->
110
+
timed_to "overlay umount" t_umount (fun () ->
93
111
ignore (Day11_container.Overlay.umount env merged)))
94
112
(fun () ->
95
113
let spec =
···
116
134
~finally:(fun () ->
117
135
ignore (Day11_container.Runc.delete env container_id))
118
136
(fun () ->
119
-
timed "runc run" (fun () ->
137
+
timed_to "runc run" t_runc (fun () ->
120
138
Day11_container.Runc.run env ~bundle:temp_dir
121
139
~container_id)))
122
140
in
123
141
(* Always clean up internals — only upper survives *)
124
-
timed "cleanup internals" (fun () -> cleanup_internals ());
142
+
timed_to "cleanup internals" t_cleanup (fun () -> cleanup_internals ());
143
+
let timing : Day11_layer.Layer_meta.timing = {
144
+
merge = !t_merge; dump_state = !t_dump; chown = !t_chown;
145
+
overlay_mount = !t_mount; runc_run = !t_runc;
146
+
overlay_umount = !t_umount; cleanup = !t_cleanup;
147
+
extract = 0.; (* filled in by build_layer *)
148
+
total = Unix.gettimeofday () -. t_total;
149
+
} in
125
150
match run_result with
126
-
| Ok run -> Ok (run, upper)
151
+
| Ok run -> Ok (run, upper, timing)
127
152
| Error _ as e ->
128
153
ignore (Day11_exec.Sudo.rm_rf env temp_dir);
129
154
e
+6
-3
day11/build/run_in_layers.mli
+6
-3
day11/build/run_in_layers.mli
···
11
11
gid:int ->
12
12
?mounts:Day11_container.Mount.t list ->
13
13
string ->
14
-
(Day11_exec.Run.t * Fpath.t, [> Rresult.R.msg ]) result
14
+
(Day11_exec.Run.t * Fpath.t * Day11_layer.Layer_meta.timing,
15
+
[> Rresult.R.msg ]) result
15
16
(** [run env ~base ~build_dirs ~uid ~gid ?mounts cmd] runs [cmd]
16
17
in a container with [base] and [build_dirs] stacked as an overlay.
17
18
18
-
Returns [(run_result, upper_dir)] on success. The caller is
19
-
responsible for extracting what they need and cleaning up. *)
19
+
Returns [(run_result, upper_dir, timing)] on success. [timing]
20
+
records how long each phase took (merge, dump_state, overlay mount,
21
+
runc run, cleanup, etc.). The caller is responsible for extracting
22
+
what they need and cleaning up. *)
+19
day11/layer/layer_meta.ml
+19
day11/layer/layer_meta.ml
···
1
+
type timing = {
2
+
merge : float; [@default 0.]
3
+
dump_state : float; [@default 0.]
4
+
chown : float; [@default 0.]
5
+
overlay_mount : float; [@default 0.]
6
+
runc_run : float; [@default 0.]
7
+
overlay_umount : float; [@default 0.]
8
+
cleanup : float; [@default 0.]
9
+
extract : float; [@default 0.]
10
+
total : float; [@default 0.]
11
+
} [@@deriving yojson]
12
+
13
+
let empty_timing = {
14
+
merge = 0.; dump_state = 0.; chown = 0.; overlay_mount = 0.;
15
+
runc_run = 0.; overlay_umount = 0.; cleanup = 0.; extract = 0.;
16
+
total = 0.;
17
+
}
18
+
1
19
type build_meta = {
2
20
package : string;
3
21
exit_status : int;
···
11
29
patches : string list; [@default []]
12
30
failed_dep : string option; [@default None]
13
31
disk_usage : int; [@default 0]
32
+
timing : timing; [@default empty_timing]
14
33
created_at : string;
15
34
} [@@deriving yojson]
16
35
+15
day11/layer/layer_meta.mli
+15
day11/layer/layer_meta.mli
···
3
3
Each layer type has its own metadata record. Serialization
4
4
is derived via [ppx_deriving_yojson]. *)
5
5
6
+
type timing = {
7
+
merge : float; (** hardlink dep layers into lower dir *)
8
+
dump_state : float; (** write switch-state from packages dirs *)
9
+
chown : float; (** fix overlay upper permissions *)
10
+
overlay_mount : float; (** mount overlayfs *)
11
+
runc_run : float; (** actual container execution *)
12
+
overlay_umount : float;(** unmount overlayfs *)
13
+
cleanup : float; (** remove temp dirs *)
14
+
extract : float; (** move upper to layer, scan files *)
15
+
total : float; (** wall clock for the whole build *)
16
+
} [@@deriving yojson]
17
+
18
+
val empty_timing : timing
19
+
6
20
type build_meta = {
7
21
package : string;
8
22
exit_status : int;
···
16
30
patches : string list;
17
31
failed_dep : string option;
18
32
disk_usage : int;
33
+
timing : timing;
19
34
created_at : string;
20
35
} [@@deriving yojson]
21
36