gazagnaire.org
Declarative provisioning that converges a provider to a spec
caravan: drop the target field that armed nothing, and quote a power argv
A spool target carried a device-key, decoded and handed to the backend, where
only admit_provision reads it -- and that runs only inside Ground.report, which
this CLI never calls. Admission happens when a report is written; the CLI
observes reports it did not write. So the field named a gate that could never
run, and an operator setting it had every reason to think claims were being
checked. The gate itself is real and tested; it belongs to the fleet service,
which uses the library and holds its own keys, as the keys for a drained window
already do. Saying so in the config interface is the fix; carrying a dead field
is not.
Landed 50e2e0e claimed a target "now pins the device's public half", which was
wrong in exactly this way.
Separately, a power command was split on bare spaces, so `command pdu --label
"rack 4" cycle %s` reached the tool as five arguments where it meant four. It
now splits on whitespace with double-quoted runs held together, and prints back
in a form that parses -- an unterminated quote is an error rather than a guess
at where it ended. Still an argv and still no shell, so the quoting decides word
boundaries and nothing else.
author
Thomas Gazagnaire
date
(Jul 24, 2026, 10:37 PM -0700)
commit
459402c2
459402c23925b9ef39556a1eec41f6d295f475e6
parent
d4eb6079
d4eb6079314a2fa468fc9c70213b7aa85ea834e8
+80
-49
-1
README.md
-1
README.md
+2
-18
bin/common.ml
+2
-18
bin/common.ml
···
51
51
| Ok key -> Ok (Some (Signer.Software.v key))
52
52
| Error (`Msg message) -> err_msg "intent-key %s: %s" path message))
53
53
54
-
(* The device's public half, which a state report's provision claims are checked
55
-
against: convergence is declared on what a witness proves, not on what the
56
-
report says. Absent means an ungated spool -- the claims are taken at face
57
-
value, which only a spool nobody but the device can write can afford. *)
58
-
let device_public_key = function
59
-
| None -> Ok None
60
-
| Some path -> (
61
-
match In_channel.with_open_bin path In_channel.input_all with
62
-
| exception Sys_error message -> err_msg "device-key: %s" message
63
-
| pem -> (
64
-
match X509.Public_key.decode_pem pem with
65
-
| Ok key -> Ok (Some key)
66
-
| Error (`Msg message) -> err_msg "device-key %s: %s" path message))
67
-
68
54
(* Load the target, connect its provider, pack it into an engine, and hand the
69
55
spec and the engine to the command body. Every branch runs inside one Eio
70
56
scope, so all four backends are constructed the same way -- labelled
···
92
78
~device ~boot ~serial ~power ()
93
79
in
94
80
f spec (Target (Board_engine.v backend))
95
-
| Config.Spool { directory; intent_key; device_key } ->
81
+
| Config.Spool { directory; intent_key } ->
96
82
let* signer = intent_signer intent_key in
97
-
let* device_key = device_public_key device_key in
98
83
let* backend =
99
-
Caravan_spool.v ?signer ?device_key ~fs:(Eio.Stdenv.fs env)
100
-
~spool:directory ()
84
+
Caravan_spool.v ?signer ~fs:(Eio.Stdenv.fs env) ~spool:directory ()
101
85
in
102
86
f spec (Target (Spool_engine.v backend))
103
87
| Config.Scaleway { zone } ->
+3
-8
bin/config.ml
+3
-8
bin/config.ml
···
13
13
power : Caravan_board.Power.t;
14
14
}
15
15
16
-
type spool = {
17
-
directory : string;
18
-
intent_key : string option;
19
-
device_key : string option;
20
-
}
16
+
type spool = { directory : string; intent_key : string option }
21
17
22
18
type provider =
23
19
| Scaleway of scaleway
···
84
80
85
81
let spool_codec =
86
82
C.Mapping.(
87
-
map ~kind:"spool settings" (fun directory intent_key device_key ->
88
-
{ directory; intent_key; device_key })
83
+
map ~kind:"spool settings" (fun directory intent_key ->
84
+
{ directory; intent_key })
89
85
|> mem "directory" C.string ~enc:(fun t -> t.directory)
90
86
|> opt_mem "intent-key" C.string ~enc:(fun t -> t.intent_key)
91
-
|> opt_mem "device-key" C.string ~enc:(fun t -> t.device_key)
92
87
|> error_unknown |> seal)
93
88
94
89
let provider_cases =
+9
-10
bin/config.mli
+9
-10
bin/config.mli
···
30
30
{!field-power} how it is powered. Every field is required: a board says how
31
31
it behaves rather than inheriting it from a per-board preset. *)
32
32
33
-
type spool = {
34
-
directory : string;
35
-
intent_key : string option;
36
-
device_key : string option;
37
-
}
33
+
type spool = { directory : string; intent_key : string option }
38
34
(** {!field-directory} holds the outbox and the device's state report.
39
35
{!field-intent_key} is a PEM private key that signs every intent this CLI
40
36
queues, so a transport pinned to its public half drains them; absent queues
41
-
unsigned intents, which a verifying transport refuses. {!field-device_key}
42
-
is the device's PEM public key, which the provision state a report claims is
43
-
checked against, so convergence follows what a witness proves rather than
44
-
what the report says; absent takes the claims at face value, which only a
45
-
spool nobody but the device can write can afford. *)
37
+
unsigned intents, which a verifying transport refuses.
38
+
39
+
There is no device key here. The key that admits a device's provision claims
40
+
is used when a state report is {e written}, which only
41
+
{!Caravan_spool.Ground.report} does -- a fleet service, not this CLI, which
42
+
observes reports it did not write. Configuring one here would name a gate
43
+
that could never run. The same goes for the keys that authenticate a drained
44
+
window; they belong to the program that drains it. *)
46
45
47
46
type provider =
48
47
| Scaleway of scaleway (** The cloud target, through the scw profile. *)
+45
-11
lib/board/caravan_board.ml
+45
-11
lib/board/caravan_board.ml
···
25
25
are no per-board presets, so nothing about how a board is powered is implied by
26
26
its name. *)
27
27
module Power = struct
28
-
type t = Manual | Always_on | Command of string
28
+
type t = Manual | Always_on | Command of string list
29
+
30
+
(* Split into arguments the way a reader expects: whitespace separates, and a
31
+
double-quoted run is one argument. A PDU invocation carrying a label with a
32
+
space in it is ordinary, and splitting on bare spaces would hand the tool five
33
+
arguments where it wanted four. The result is an argv -- never a shell string
34
+
-- so quoting here decides word boundaries and nothing else. *)
35
+
let argv_of_string s =
36
+
let words = ref [] and word = Buffer.create 16 and quoted = ref false in
37
+
let flush () =
38
+
if Buffer.length word > 0 then begin
39
+
words := Buffer.contents word :: !words;
40
+
Buffer.clear word
41
+
end
42
+
in
43
+
String.iter
44
+
(fun c ->
45
+
match c with
46
+
| '"' -> quoted := not !quoted
47
+
| (' ' | '\t') when not !quoted -> flush ()
48
+
| c -> Buffer.add_char word c)
49
+
s;
50
+
flush ();
51
+
if !quoted then Error "unterminated quote" else Ok (List.rev !words)
29
52
30
53
let of_string s =
31
-
match String.split_on_char ' ' (String.trim s) with
32
-
| [ "manual" ] -> Ok Manual
33
-
| [ "always-on" ] -> Ok Always_on
34
-
| "command" :: (_ :: _ as rest) -> Ok (Command (String.concat " " rest))
35
-
| _ ->
36
-
err
37
-
"power %S: expected \"manual\", \"always-on\", or \"command <argv>\""
38
-
s
54
+
match argv_of_string (String.trim s) with
55
+
| Error reason -> err "power %S: %s" s reason
56
+
| Ok argv -> (
57
+
match argv with
58
+
| [ "manual" ] -> Ok Manual
59
+
| [ "always-on" ] -> Ok Always_on
60
+
| "command" :: (_ :: _ as rest) -> Ok (Command rest)
61
+
| _ ->
62
+
err
63
+
"power %S: expected \"manual\", \"always-on\", or \"command \
64
+
<argv>\""
65
+
s)
39
66
40
67
let pp ppf = function
41
68
| Manual -> Fmt.string ppf "manual"
42
69
| Always_on -> Fmt.string ppf "always-on"
43
-
| Command argv -> Fmt.pf ppf "command %s" argv
70
+
| Command argv ->
71
+
(* Re-quote what needed quoting, so a printed strategy parses back. *)
72
+
let word w =
73
+
if String.exists (function ' ' | '\t' -> true | _ -> false) w then
74
+
Fmt.str "\"%s\"" w
75
+
else w
76
+
in
77
+
Fmt.pf ppf "command %s" (String.concat " " (List.map word argv))
44
78
end
45
79
46
80
(* The boot partition is held as a capability: it is the provider database, and
···
366
400
let argv =
367
401
List.map
368
402
(fun word -> if String.equal word "%s" then t.serial else word)
369
-
(String.split_on_char ' ' argv)
403
+
argv
370
404
in
371
405
match Eio.Process.run t.proc argv with
372
406
| () ->
+1
-1
lib/board/caravan_board.mli
+1
-1
lib/board/caravan_board.mli
···
36
36
(** The board is powered whenever it is attached, so there is no step to
37
37
take. This is also what makes the flash path exercisable without a
38
38
hand on a bench. *)
39
-
| Command of string
39
+
| Command of string list
40
40
(** An argv to run, with [%s] standing for the board's serial: a PDU, a
41
41
relay board, a lab-automation hook. Run as an argv and never through
42
42
a shell, so a serial cannot be re-read as syntax. *)
+20
test/board/test_caravan_board.ml
+20
test/board/test_caravan_board.ml
···
180
180
parses "manual" "manual";
181
181
parses "always-on" "always-on";
182
182
parses "command pdu cycle %s" "command pdu cycle %s";
183
+
(* A label with a space in it is one argument, not two: printing re-quotes it,
184
+
so a strategy round-trips through the target file. *)
185
+
parses "command pdu --label \"rack 4\" cycle %s"
186
+
"command pdu --label \"rack 4\" cycle %s";
187
+
(match
188
+
Caravan_board.Power.of_string "command pdu --label \"rack 4\" cycle %s"
189
+
with
190
+
| Ok (Caravan_board.Power.Command argv) ->
191
+
Alcotest.(check (list string))
192
+
"the quoted run is one argument"
193
+
[ "pdu"; "--label"; "rack 4"; "cycle"; "%s" ]
194
+
argv
195
+
| Ok _ | Error _ -> Alcotest.fail "a quoted command must parse");
196
+
(* An unterminated quote is an error, not a guess at where it ended. *)
197
+
(match Caravan_board.Power.of_string "command pdu --label \"rack 4" with
198
+
| Ok _ -> Alcotest.fail "an unterminated quote must not parse"
199
+
| Error message ->
200
+
Alcotest.(check bool)
201
+
"the error names the quote" true
202
+
(Astring.String.is_infix ~affix:"quote" message));
183
203
match Caravan_board.Power.of_string "whenever" with
184
204
| Ok _ -> Alcotest.fail "an unknown power strategy must not parse"
185
205
| Error message ->