gazagnaire.org
OCI-oriented build engine
builder: switch the CLI setup to observe and depend on probe
author
Thomas Gazagnaire
date
(Jun 11, 2026, 2:46 PM -0700)
commit
932b45c5
932b45c5ab5058f4fae9d614d5278fb82d5622b8
parent
1ea2ca75
1ea2ca75f7565d9cca3f489119f5698e1950d8c9
+162
-27
+1
-1
Dockerfile.test
+1
-1
Dockerfile.test
···
46
46
&& opam pin add -yn requests ./ocaml-requests \
47
47
&& opam pin add -yn nox-tty.0.1 ./ocaml-tty \
48
48
&& opam pin add -yn nox-xdg ./ocaml-xdg \
49
-
&& opam pin add -yn vlog.0.1 ./ocaml-vlog \
49
+
&& opam pin add -yn ocaml-observe.0.1 ./ocaml-observe \
50
50
&& opam pin add -yn oci ./ocaml-oci \
51
51
&& opam pin add -yn runc ./ocaml-runc \
52
52
&& opam pin add -yn seatbelt ./ocaml-seatbelt \
+1
-1
bin/main.ml
+1
-1
bin/main.ml
+2
-1
builder.opam
+2
-1
builder.opam
+2
-1
dune-project
+2
-1
dune-project
+3
-3
fuzz/fuzz_cache_key.ml
+3
-3
fuzz/fuzz_cache_key.ml
···
32
32
manager;
33
33
}
34
34
35
-
let contains ~needle haystack =
36
-
Re.execp (Re.compile (Re.str needle)) haystack
35
+
let contains ~needle haystack = Re.execp (Re.compile (Re.str needle)) haystack
37
36
38
37
(* A plain RUN step's command key always contains its full space-joined argv, so
39
38
two RUN steps that differ in any argument are distinct steps. *)
···
57
56
let p = atom p and o1 = atom o1 and o2 = atom o2 in
58
57
let id po o = Cache_key.step_id ~parent_id:po ~op_key:o in
59
58
check (String.equal (id p o1) (id p o1));
60
-
if String.compare o1 o2 <> 0 then check (String.compare (id p o1) (id p o2) <> 0)
59
+
if String.compare o1 o2 <> 0 then
60
+
check (String.compare (id p o1) (id p o2) <> 0)
61
61
62
62
let suite =
63
63
( "cache_key",
+5
-3
fuzz/fuzz_cache_key.mli
+5
-3
fuzz/fuzz_cache_key.mli
···
1
+
(** Cache key fuzz suite. *)
2
+
1
3
val suite : string * Alcobar.test_case list
2
4
(** Property/fuzz tests for {!Builder.Cache_key}: a plain RUN command key keeps
3
-
its full argv, a package-manager step keys only on its manager tag
4
-
(identity comes from the resolved layer), and the step id is injective in its
5
-
op key and parent. *)
5
+
its full argv, a package-manager step keys only on its manager tag (identity
6
+
comes from the resolved layer), and the step id is injective in its op key
7
+
and parent. *)
+3
-4
lib/cache_key.ml
+3
-4
lib/cache_key.ml
···
36
36
| Error _ -> String.concat "," r.Plan.network
37
37
38
38
let env_key env =
39
-
Fmt.to_to_string
40
-
Fmt.(list ~sep:comma (pair ~sep:(any "=") string string))
41
-
env
39
+
Fmt.to_to_string Fmt.(list ~sep:comma (pair ~sep:(any "=") string string)) env
42
40
43
41
let secrets_key (secrets : Builder_spec.Secret.t list) =
44
42
Fmt.to_to_string
45
43
Fmt.(
46
44
list ~sep:comma
47
-
(using (fun (s : Builder_spec.Secret.t) -> (s.id, s.target))
45
+
(using
46
+
(fun (s : Builder_spec.Secret.t) -> (s.id, s.target))
48
47
(pair ~sep:(any ":") string string)))
49
48
secrets
50
49
+9
-7
lib/cache_key.mli
+9
-7
lib/cache_key.mli
···
1
1
(** Pure, deterministic cache-key components for build steps.
2
2
3
-
A build step's cache identity is hashed from its resolved plan; these are the
4
-
parts of that hash that depend only on the plan (not on engine backend/store
5
-
state). They are factored out here so the keying — where a wrong key silently
6
-
reuses another step's layer — can be unit-tested and fuzzed in isolation. *)
3
+
A build step's cache identity is hashed from its resolved plan; these are
4
+
the parts of that hash that depend only on the plan (not on engine
5
+
backend/store state). They are factored out here so the keying — where a
6
+
wrong key silently reuses another step's layer — can be unit-tested and
7
+
fuzzed in isolation. *)
7
8
8
9
val digest : string -> string
9
10
(** [digest s] is the hex SHA-256 of [s], the hash the step ids fold through. *)
···
21
22
22
23
val network_key : Plan.run -> string
23
24
(** [network_key r] is the cache-key fragment for a step's resolved network
24
-
mode, so equivalent hints ([\[\]] and [\["default"\]]) share an entry. *)
25
+
mode, so equivalent hints ([[]] and [["default"]]) share an entry. *)
25
26
26
27
val env_key : (string * string) list -> string
27
28
(** [env_key env] formats a step's environment for the cache key. *)
···
32
33
33
34
val step_id : parent_id:string -> op_key:string -> string
34
35
(** [step_id ~parent_id ~op_key] is a step's content id: the parent chain's id
35
-
folded with this step's op key, so the id pins the step and all it builds on.
36
-
Deterministic and collision-resistant in [op_key] for a fixed [parent_id]. *)
36
+
folded with this step's op key, so the id pins the step and all it builds
37
+
on. Deterministic and collision-resistant in [op_key] for a fixed
38
+
[parent_id]. *)
+1
lib/dune
+1
lib/dune
+129
-1
lib/engine.ml
+129
-1
lib/engine.ml
···
1167
1167
}
1168
1168
| Step_log of { id : string; line : string }
1169
1169
1170
+
type build_start_probe = { steps : int }
1171
+
1172
+
type step_probe = {
1173
+
id : string;
1174
+
op : string;
1175
+
name : string;
1176
+
log : string;
1177
+
error : string;
1178
+
}
1179
+
1180
+
type progress_probe = {
1181
+
id : string;
1182
+
status : string;
1183
+
current : int64;
1184
+
total : int64;
1185
+
total_known : bool;
1186
+
}
1187
+
1188
+
type log_probe = { id : string; line : string }
1189
+
1190
+
let string_of_op = function `Run -> "run" | `Copy -> "copy" | `Base -> "base"
1191
+
1192
+
let string_of_path = function
1193
+
| None -> ""
1194
+
| Some path -> ( try Eio.Path.native_exn path with Invalid_argument _ -> "")
1195
+
1196
+
let build_start_probe =
1197
+
Probe.event "builder.build.start" ~doc:"Builder build started"
1198
+
Probe.Fields.(
1199
+
obj (fun steps -> ({ steps } : build_start_probe))
1200
+
|> field "steps" int ~enc:(fun t -> t.steps)
1201
+
|> seal)
1202
+
1203
+
let step_fields =
1204
+
Probe.Fields.(
1205
+
obj (fun id op name log error ->
1206
+
({ id; op; name; log; error } : step_probe))
1207
+
|> field "id" string ~enc:(fun (t : step_probe) -> t.id)
1208
+
|> field "op" string ~enc:(fun (t : step_probe) -> t.op)
1209
+
|> field "name" string ~enc:(fun (t : step_probe) -> t.name)
1210
+
|> field "log" string ~enc:(fun (t : step_probe) -> t.log)
1211
+
|> field "error" string ~enc:(fun (t : step_probe) -> t.error)
1212
+
|> seal)
1213
+
1214
+
let step_start_probe =
1215
+
Probe.event "builder.step.start" ~doc:"Builder step started" step_fields
1216
+
1217
+
let step_cached_probe =
1218
+
Probe.event "builder.step.cached" ~doc:"Builder step cache hit" step_fields
1219
+
1220
+
let step_done_probe =
1221
+
Probe.event "builder.step.done" ~doc:"Builder step completed" step_fields
1222
+
1223
+
let step_failed_probe =
1224
+
Probe.event "builder.step.failed" ~doc:"Builder step failed" step_fields
1225
+
1226
+
let step_progress_probe =
1227
+
Probe.event "builder.step.progress" ~doc:"Builder step byte progress"
1228
+
Probe.Fields.(
1229
+
obj (fun id status current total total_known ->
1230
+
({ id; status; current; total; total_known } : progress_probe))
1231
+
|> field "id" string ~enc:(fun (t : progress_probe) -> t.id)
1232
+
|> field "status" string ~enc:(fun (t : progress_probe) -> t.status)
1233
+
|> field "current" int64 ~enc:(fun (t : progress_probe) -> t.current)
1234
+
|> field "total" int64 ~enc:(fun (t : progress_probe) -> t.total)
1235
+
|> field "total_known" bool ~enc:(fun (t : progress_probe) ->
1236
+
t.total_known)
1237
+
|> seal)
1238
+
1239
+
let step_log_probe =
1240
+
Probe.event "builder.step.log" ~doc:"Builder step output line"
1241
+
Probe.Fields.(
1242
+
obj (fun id line -> ({ id; line } : log_probe))
1243
+
|> field "id" string ~enc:(fun (t : log_probe) -> t.id)
1244
+
|> field "line" string ~enc:(fun (t : log_probe) -> t.line)
1245
+
|> seal)
1246
+
1247
+
let emit_probe = function
1248
+
| Build_start { steps } -> Probe.emit build_start_probe { steps }
1249
+
| Step_start { id; op; name } ->
1250
+
Probe.emit step_start_probe
1251
+
{
1252
+
id;
1253
+
op = string_of_op op;
1254
+
name = Option.value name ~default:"";
1255
+
log = "";
1256
+
error = "";
1257
+
}
1258
+
| Step_cached { id; op; name } ->
1259
+
Probe.emit step_cached_probe
1260
+
{
1261
+
id;
1262
+
op = string_of_op op;
1263
+
name = Option.value name ~default:"";
1264
+
log = "";
1265
+
error = "";
1266
+
}
1267
+
| Step_done { id; op; name; log } ->
1268
+
Probe.emit step_done_probe
1269
+
{
1270
+
id;
1271
+
op = string_of_op op;
1272
+
name = Option.value name ~default:"";
1273
+
log = string_of_path log;
1274
+
error = "";
1275
+
}
1276
+
| Step_failed { id; op; name; log; error } ->
1277
+
Probe.emit step_failed_probe
1278
+
{
1279
+
id;
1280
+
op = string_of_op op;
1281
+
name = Option.value name ~default:"";
1282
+
log = string_of_path log;
1283
+
error;
1284
+
}
1285
+
| Step_progress { id; status; current; total } ->
1286
+
Probe.emit step_progress_probe
1287
+
{
1288
+
id;
1289
+
status;
1290
+
current;
1291
+
total = Option.value total ~default:(-1L);
1292
+
total_known = Option.is_some total;
1293
+
}
1294
+
| Step_log { id; line } -> Probe.emit step_log_probe { id; line }
1295
+
1170
1296
module Make (B : Backend.BACKEND) = struct
1171
1297
type run_exec =
1172
1298
cancelled:unit Eio.Promise.t ->
···
1192
1318
let store = Store.v ?store state_dir in
1193
1319
{ store; backend; backend_id; backend_prepare_run; template; on_event }
1194
1320
1195
-
let emit t event = t.on_event event
1321
+
let emit t event =
1322
+
emit_probe event;
1323
+
t.on_event event
1196
1324
1197
1325
(* Total bytes under [path] (regular files only); the COPY total for progress.
1198
1326
Exact for a whole-context [COPY . .]. *)
+5
-4
test/test_cache_key.ml
+5
-4
test/test_cache_key.ml
···
18
18
manager;
19
19
}
20
20
21
-
let neq msg a b =
22
-
Alcotest.(check bool) msg true (String.compare a b <> 0)
21
+
let neq msg a b = Alcotest.(check bool) msg true (String.compare a b <> 0)
23
22
24
23
(* A package-manager step keys ONLY on its manager, not the command words: its
25
24
identity is the resolved layer (carried in the engine's backend run key), so
···
31
30
let bar = run ~manager:(Some "apk") ~argv:[ "apk"; "add"; "bar" ] () in
32
31
Alcotest.(check string)
33
32
"a pkg command key is the manager tag, independent of the command words"
34
-
(Cache_key.command_key foo) (Cache_key.command_key bar);
35
-
neq "different managers are still distinct" (Cache_key.command_key foo)
33
+
(Cache_key.command_key foo)
34
+
(Cache_key.command_key bar);
35
+
neq "different managers are still distinct"
36
+
(Cache_key.command_key foo)
36
37
(Cache_key.command_key
37
38
(run ~manager:(Some "opam") ~argv:[ "apk"; "add"; "foo" ] ()))
38
39