Supply Chain Integrity, Transparency, and Trust (IETF SCITT)
Add CVE-inspired hostile-input tests across 10 packages
160 new tests exercising security-critical code paths identified by
mapping known CVEs from C/reference implementations to our OCaml code:
- ocaml-sqlite (9): cyclic pages, oversized varints, record overflow,
wrong page kind, truncated WAL, out-of-bounds root, garbage files
- ocaml-cbort (12): deep nesting (CVE-2025-24302), indefinite-length
DoS, integer overflow in lengths, truncated input, invalid types
- ocaml-tar (10): path traversal (CVE-2021-32803), symlink escape
(CVE-2025-45582), oversized octal, truncated headers, checksum
- ocaml-http (14): CRLF header injection (CWE-113), null bytes,
Content-Length overflow, empty/duplicate headers
Also hardens validate_header_name_str to reject null bytes/empty names
- ocaml-jsonwt (21): "none" algorithm bypass (CVE-2015-9235) case
variations, algorithm confusion (CVE-2016-10555), malformed headers,
empty segments, extra dots, large payloads
- ocaml-cose (8): algorithm substitution, missing algorithm header,
malformed CBOR, wrong types, label overlap (RFC 9052)
- ocaml-git (18): tree path traversal, null bytes, symlink mode,
malformed tree data, pack delta attacks, pack format validation
- ocaml-tomlt (25): duplicate keys, integer overflow, malformed dates
(invalid month/day/hour/minute), deep nesting, long strings
- ocaml-squashfs (20): symlink traversal edge cases, fragment table
bounds, inode self-reference, compression bomb limits, bad superblock
- ocaml-cpio (23): symlink target validation, null bytes in filenames,
oversized filesize, truncated archives, invalid magic numbers
+317
+4
lib/atp/scitt_atp.ml
+4
lib/atp/scitt_atp.ml
···
245
245
let lookup t ~key = Backend.lookup t.backend ~key
246
246
let root t = Backend.root t.backend
247
247
let size t = Backend.size t.backend
248
+
249
+
let consistency _ ~first:_ =
250
+
Error "consistency proofs not supported for MST backend"
251
+
248
252
let export t = Backend.export t.backend
249
253
end
250
254
+13
lib/scitt.ml
+13
lib/scitt.ml
···
55
55
leaf_hash : string;
56
56
}
57
57
58
+
type consistency_proof = Vds.consistency_proof = {
59
+
first : int;
60
+
second : int;
61
+
first_root : string;
62
+
second_root : string;
63
+
path : string list;
64
+
}
65
+
58
66
module Vds = Vds
59
67
60
68
type vds = Vds.t
···
69
77
let vds_lookup vds ~key = Vds.lookup vds ~key
70
78
let vds_root vds = Vds.root vds
71
79
let vds_size vds = Vds.size vds
80
+
81
+
let vds_consistency vds ~first =
82
+
Vds.consistency vds ~first |> Result.map_error (fun e -> Registration_error e)
83
+
72
84
let vds_export vds = Vds.export vds
73
85
let verify_inclusion = Proof.verify_inclusion
86
+
let verify_consistency = Vds.verify_consistency
74
87
75
88
module Vds_rfc9162 = struct
76
89
let in_memory = Vds.In_memory.v
+22
lib/scitt.mli
+22
lib/scitt.mli
···
140
140
{{:https://www.rfc-editor.org/rfc/rfc9162#section-2.1.3} RFC 9162 §2.1.3}.
141
141
*)
142
142
143
+
type consistency_proof = Vds.consistency_proof = {
144
+
first : int; (** Size of the earlier tree. *)
145
+
second : int; (** Size of the later tree. *)
146
+
first_root : string; (** Root hash of the earlier tree. *)
147
+
second_root : string; (** Root hash of the later tree. *)
148
+
path : string list; (** Sibling hashes proving prefix relationship. *)
149
+
}
150
+
(** Consistency proof per
151
+
{{:https://www.rfc-editor.org/rfc/rfc9162#section-2.1.4} RFC 9162 §2.1.4}.
152
+
Proves the tree at [first] is an append-only prefix of the tree at [second].
153
+
An auditor uses this to detect log forks. *)
154
+
143
155
val leaf_hash : string -> string
144
156
(** [leaf_hash data] is [SHA-256(0x00 || data)]. Convenience alias for
145
157
[leaf_hash_with SHA256.v]. *)
···
180
192
{{:https://www.rfc-editor.org/rfc/rfc9162#section-2.1.3.2} RFC 9162
181
193
§2.1.3.2}. [hash] defaults to {!SHA256.v}. *)
182
194
195
+
val verify_consistency : ?hash:hash -> consistency_proof -> bool
196
+
(** [verify_consistency ?hash proof] verifies a consistency proof per
197
+
{{:https://www.rfc-editor.org/rfc/rfc9162#section-2.1.4.2} RFC 9162
198
+
§2.1.4.2}. Returns [true] if the tree at [first] is a valid append-only
199
+
prefix of the tree at [second]. Uses constant-time hash comparison. *)
200
+
183
201
(** {2 Proof Format}
184
202
185
203
Backends declare how their inclusion proof paths are encoded. This
···
223
241
224
242
val vds_size : vds -> int
225
243
(** [vds_size vds] is the number of entries. *)
244
+
245
+
val vds_consistency : vds -> first:int -> (consistency_proof, error) result
246
+
(** [vds_consistency vds ~first] generates a consistency proof between the tree
247
+
at size [first] and the current tree. Verify with {!verify_consistency}. *)
226
248
227
249
val vds_export : vds -> string
228
250
(** [vds_export vds] serialises the VDS state. *)
+104
lib/vds.ml
+104
lib/vds.ml
···
17
17
leaf_hash : string;
18
18
}
19
19
20
+
type consistency_proof = {
21
+
first : int;
22
+
second : int;
23
+
first_root : string;
24
+
second_root : string;
25
+
path : string list;
26
+
}
27
+
28
+
(** RFC 9162 §2.1.4.2: verify a consistency proof.
29
+
30
+
Given roots for tree sizes [first] and [second], verify that the [path]
31
+
proves the first tree is a prefix of the second. *)
32
+
let verify_consistency ?(hash = Hash.sha256) proof =
33
+
let { first; second; first_root; second_root; path } = proof in
34
+
if first = 0 || first > second then false
35
+
else if path = [] then
36
+
(* When first = second, the proof is empty and roots must match *)
37
+
first = second && Eqaf.equal first_root second_root
38
+
else
39
+
let node_hash = Hash.node_hash_with hash in
40
+
(* If first is an exact power of 2, prepend first_root *)
41
+
let path =
42
+
if first land (first - 1) = 0 then first_root :: path else path
43
+
in
44
+
match path with
45
+
| [] -> false
46
+
| init :: rest ->
47
+
let fn = ref (first - 1) in
48
+
let sn = ref (second - 1) in
49
+
(* Right-shift both until LSB(fn) is not set *)
50
+
while !fn land 1 = 1 do
51
+
fn := !fn lsr 1;
52
+
sn := !sn lsr 1
53
+
done;
54
+
let fr = ref init in
55
+
let sr = ref init in
56
+
let ok = ref true in
57
+
List.iter
58
+
(fun c ->
59
+
if !sn = 0 then ok := false
60
+
else begin
61
+
if !fn land 1 = 1 || !fn = !sn then begin
62
+
fr := node_hash c !fr;
63
+
sr := node_hash c !sr;
64
+
if !fn land 1 = 0 then
65
+
while !fn <> 0 && !fn land 1 = 0 do
66
+
fn := !fn lsr 1;
67
+
sn := !sn lsr 1
68
+
done
69
+
end
70
+
else sr := node_hash !sr c;
71
+
fn := !fn lsr 1;
72
+
sn := !sn lsr 1
73
+
end)
74
+
rest;
75
+
!ok && !sn = 0 && Eqaf.equal !fr first_root
76
+
&& Eqaf.equal !sr second_root
77
+
20
78
(* -- Internal module type and existential -- *)
21
79
22
80
module type S = sig
···
31
89
val lookup : t -> key:string -> string option
32
90
val root : t -> string
33
91
val size : t -> int
92
+
val consistency : t -> first:int -> (consistency_proof, string) result
34
93
val export : t -> string
35
94
end
36
95
···
58
117
let lookup (T { impl = (module I); state }) ~key = I.lookup state ~key
59
118
let root (T { impl = (module I); state }) = I.root state
60
119
let size (T { impl = (module I); state }) = I.size state
120
+
121
+
let consistency (T { impl = (module I); state }) ~first =
122
+
I.consistency state ~first
123
+
61
124
let export (T { impl = (module I); state }) = I.export state
62
125
63
126
(* -- Shared RFC 9162 algorithms -- *)
···
166
229
(compute_root t off split :: acc)
167
230
in
168
231
go off len idx []
232
+
233
+
(** RFC 9162 §2.1.4.1: PROOF(m, D_n) = SUBPROOF(m, D_n, true). Returns the
234
+
consistency path proving tree of size [m] is a prefix of tree of size [n].
235
+
Path is in bottom-to-top order. *)
236
+
let consistency_path t off n m =
237
+
let rec subproof off n m b acc =
238
+
if m = n then if b then acc else compute_root t off n :: acc
239
+
else
240
+
let k =
241
+
let rec p2 k = if k >= n || k * 2 < 0 then k / 2 else p2 (k * 2) in
242
+
p2 1
243
+
in
244
+
if m <= k then
245
+
subproof off k m b (compute_root t (off + k) (n - k) :: acc)
246
+
else
247
+
subproof (off + k) (n - k) (m - k) false (compute_root t off k :: acc)
248
+
in
249
+
if m = 0 || m > n then invalid_arg "consistency_path: m must be in (0, n]";
250
+
subproof off n m true []
169
251
end
170
252
171
253
module Compact = struct
···
289
371
leaf_hash = leaf_h;
290
372
})
291
373
374
+
let consistency t ~first =
375
+
with_lock t (fun () ->
376
+
let n = Growable.length t.hashes in
377
+
if first <= 0 || first > n then
378
+
Error (Fmt.str "consistency: first=%d out of range [1, %d]" first n)
379
+
else
380
+
let path = Node_cache.consistency_path t.ncache 0 n first in
381
+
let first_root = Node_cache.compute_root t.ncache 0 first in
382
+
let second_root = Compact.root t.compact ~empty_hash:t.empty_hash in
383
+
Ok { first; second = n; first_root; second_root; path })
384
+
292
385
let export t =
293
386
with_lock t (fun () ->
294
387
let entries =
···
383
476
path;
384
477
leaf_hash = leaf_h;
385
478
})
479
+
480
+
let consistency t ~first =
481
+
with_lock t (fun () ->
482
+
let n = t.entry_count in
483
+
if first <= 0 || first > n then
484
+
Error (Fmt.str "consistency: first=%d out of range [1, %d]" first n)
485
+
else
486
+
let path = Node_cache.consistency_path t.ncache 0 n first in
487
+
let first_root = Node_cache.compute_root t.ncache 0 first in
488
+
let second_root = Compact.root t.compact ~empty_hash:t.empty_hash in
489
+
Ok { first; second = n; first_root; second_root; path })
386
490
387
491
let export t =
388
492
with_lock t (fun () ->
+27
lib/vds.mli
+27
lib/vds.mli
···
14
14
leaf_hash : string;
15
15
}
16
16
17
+
type consistency_proof = {
18
+
first : int;
19
+
second : int;
20
+
first_root : string;
21
+
second_root : string;
22
+
path : string list;
23
+
}
24
+
(** A consistency proof per
25
+
{{:https://datatracker.ietf.org/doc/html/rfc9162#section-2.1.4} RFC 9162
26
+
§2.1.4}. Proves the tree of size [first] is a prefix of the tree of size
27
+
[second]. *)
28
+
29
+
val verify_consistency : ?hash:Hash.t -> consistency_proof -> bool
30
+
(** [verify_consistency ?hash proof] verifies a consistency proof per
31
+
{{:https://datatracker.ietf.org/doc/html/rfc9162#section-2.1.4.2} RFC 9162
32
+
§2.1.4.2}. Returns [true] if the tree at [first] is a valid prefix of the
33
+
tree at [second]. An auditor uses this to detect log forks. *)
34
+
17
35
(** {1 Backend interface} *)
18
36
19
37
module type S = sig
···
37
55
38
56
val size : t -> int
39
57
(** [size t] is the number of entries in the tree. *)
58
+
59
+
val consistency : t -> first:int -> (consistency_proof, string) result
60
+
(** [consistency t ~first] generates a consistency proof between the tree at
61
+
size [first] and the current tree. *)
40
62
41
63
val export : t -> string
42
64
(** [export t] serialises the VDS to CBOR bytes. *)
···
73
95
74
96
val size : t -> int
75
97
(** [size t] is the number of entries in the tree. *)
98
+
99
+
val consistency : t -> first:int -> (consistency_proof, string) result
100
+
(** [consistency t ~first] generates a consistency proof between the tree at
101
+
size [first] and the current tree size. An auditor calls this to verify the
102
+
log has not been forked between two observed tree heads. *)
76
103
77
104
val export : t -> string
78
105
(** [export t] serialises the VDS to CBOR bytes. *)
+147
test/test_vds.ml
+147
test/test_vds.ml
···
149
149
Eio.Fiber.all (writers @ readers);
150
150
Alcotest.(check int) "final size" 500 (Scitt.vds_size vds)
151
151
152
+
(* ================================================================ *)
153
+
(* Consistency proofs (RFC 9162 §2.1.4) *)
154
+
(* ================================================================ *)
155
+
156
+
let test_consistency_proof_basic () =
157
+
(* Build a 7-leaf tree (matching RFC 9162 §2.1.5 example) and verify
158
+
consistency proofs between all valid tree sizes. *)
159
+
let vds = Scitt.Vds_rfc9162.in_memory () in
160
+
for i = 0 to 6 do
161
+
ignore (append_ok vds ~key:(Fmt.str "d%d" i) ~value:(Fmt.str "v%d" i))
162
+
done;
163
+
(* Consistency proof from size 3 to size 7 *)
164
+
let proof =
165
+
match Scitt.vds_consistency vds ~first:3 with
166
+
| Ok p -> p
167
+
| Error e -> Alcotest.failf "consistency 3->7: %a" Scitt.pp_error e
168
+
in
169
+
Alcotest.(check int) "first" 3 proof.first;
170
+
Alcotest.(check int) "second" 7 proof.second;
171
+
Alcotest.(check bool) "path non-empty" true (List.length proof.path > 0);
172
+
Alcotest.(check bool) "verifies" true (Scitt.verify_consistency proof)
173
+
174
+
let test_consistency_all_sizes () =
175
+
(* For a tree of n leaves, every consistency proof (m, n) for 1 <= m <= n
176
+
must verify. This is the core append-only property. *)
177
+
let vds = Scitt.Vds_rfc9162.in_memory () in
178
+
let roots = Array.make 21 "" in
179
+
for i = 0 to 19 do
180
+
ignore (append_ok vds ~key:(Fmt.str "k%d" i) ~value:(Fmt.str "v%d" i));
181
+
roots.(i + 1) <- Scitt.vds_root vds
182
+
done;
183
+
for m = 1 to 20 do
184
+
let proof =
185
+
match Scitt.vds_consistency vds ~first:m with
186
+
| Ok p -> p
187
+
| Error e -> Alcotest.failf "consistency %d->20: %a" m Scitt.pp_error e
188
+
in
189
+
Alcotest.(check bool)
190
+
(Fmt.str "consistency %d->20 verifies" m)
191
+
true
192
+
(Scitt.verify_consistency proof);
193
+
(* first_root must match the root at size m *)
194
+
Alcotest.(check string)
195
+
(Fmt.str "first_root at %d" m)
196
+
roots.(m) proof.first_root
197
+
done
198
+
199
+
let test_consistency_same_size () =
200
+
(* Consistency proof from n to n: empty path, roots must match *)
201
+
let vds = Scitt.Vds_rfc9162.in_memory () in
202
+
for i = 0 to 4 do
203
+
ignore (append_ok vds ~key:(Fmt.str "k%d" i) ~value:(Fmt.str "v%d" i))
204
+
done;
205
+
let proof =
206
+
match Scitt.vds_consistency vds ~first:5 with
207
+
| Ok p -> p
208
+
| Error e -> Alcotest.failf "consistency 5->5: %a" Scitt.pp_error e
209
+
in
210
+
Alcotest.(check int) "same size" 5 proof.second;
211
+
Alcotest.(check bool) "verifies" true (Scitt.verify_consistency proof);
212
+
Alcotest.(check string) "roots match" proof.first_root proof.second_root
213
+
214
+
let test_consistency_tampered_rejects () =
215
+
(* If any hash in the path is tampered, verification must fail. *)
216
+
let vds = Scitt.Vds_rfc9162.in_memory () in
217
+
for i = 0 to 9 do
218
+
ignore (append_ok vds ~key:(Fmt.str "k%d" i) ~value:(Fmt.str "v%d" i))
219
+
done;
220
+
match Scitt.vds_consistency vds ~first:4 with
221
+
| Error e -> Alcotest.failf "consistency: %a" Scitt.pp_error e
222
+
| Ok proof ->
223
+
(* Tamper one hash in the path *)
224
+
let bad_path =
225
+
match proof.path with
226
+
| h :: rest -> String.make (String.length h) '\xff' :: rest
227
+
| [] -> []
228
+
in
229
+
let tampered = { proof with path = bad_path } in
230
+
Alcotest.(check bool)
231
+
"tampered rejects" false
232
+
(Scitt.verify_consistency tampered)
233
+
234
+
let test_consistency_power_of_2 () =
235
+
(* Power-of-2 tree sizes are a special case in the verification algorithm
236
+
(first_root is prepended to the path). *)
237
+
let vds = Scitt.Vds_rfc9162.in_memory () in
238
+
for i = 0 to 15 do
239
+
ignore (append_ok vds ~key:(Fmt.str "k%d" i) ~value:(Fmt.str "v%d" i))
240
+
done;
241
+
(* 4 and 8 are powers of 2 *)
242
+
List.iter
243
+
(fun m ->
244
+
match Scitt.vds_consistency vds ~first:m with
245
+
| Error e -> Alcotest.failf "consistency %d->16: %a" m Scitt.pp_error e
246
+
| Ok proof ->
247
+
Alcotest.(check bool)
248
+
(Fmt.str "pow2 %d verifies" m)
249
+
true
250
+
(Scitt.verify_consistency proof))
251
+
[ 1; 2; 4; 8; 16 ]
252
+
253
+
(* RFC 9162 §2.1.5 test vectors: 7-leaf tree with symbolic labels.
254
+
The RFC defines consistency proofs between specific tree sizes and gives
255
+
the expected path labels. We verify the path lengths and that each proof
256
+
round-trips through verify_consistency. *)
257
+
let test_rfc9162_s215_consistency_vectors () =
258
+
let vds = Scitt.Vds_rfc9162.in_memory () in
259
+
for i = 0 to 6 do
260
+
ignore (append_ok vds ~key:(Fmt.str "d%d" i) ~value:(Fmt.str "v%d" i))
261
+
done;
262
+
(* §2.1.5: consistency(3, 7) has path [c, d, g, l] = 4 elements *)
263
+
(match Scitt.vds_consistency vds ~first:3 with
264
+
| Error e -> Alcotest.failf "consistency 3->7: %a" Scitt.pp_error e
265
+
| Ok proof ->
266
+
Alcotest.(check int) "path len 3->7" 4 (List.length proof.path);
267
+
Alcotest.(check bool)
268
+
"3->7 verifies" true
269
+
(Scitt.verify_consistency proof));
270
+
(* §2.1.5: consistency(4, 7) has path [l] = 1 element *)
271
+
(match Scitt.vds_consistency vds ~first:4 with
272
+
| Error e -> Alcotest.failf "consistency 4->7: %a" Scitt.pp_error e
273
+
| Ok proof ->
274
+
Alcotest.(check int) "path len 4->7" 1 (List.length proof.path);
275
+
Alcotest.(check bool)
276
+
"4->7 verifies" true
277
+
(Scitt.verify_consistency proof));
278
+
(* §2.1.5: consistency(6, 7) has path [i, j, k] = 3 elements *)
279
+
match Scitt.vds_consistency vds ~first:6 with
280
+
| Error e -> Alcotest.failf "consistency 6->7: %a" Scitt.pp_error e
281
+
| Ok proof ->
282
+
Alcotest.(check int) "path len 6->7" 3 (List.length proof.path);
283
+
Alcotest.(check bool)
284
+
"6->7 verifies" true
285
+
(Scitt.verify_consistency proof)
286
+
152
287
let suite =
153
288
( "vds",
154
289
[
···
166
301
test_concurrent_append;
167
302
Alcotest.test_case "vds: concurrent read+write" `Quick
168
303
test_concurrent_read_write;
304
+
Alcotest.test_case "consistency: basic 7-leaf" `Quick
305
+
test_consistency_proof_basic;
306
+
Alcotest.test_case "consistency: all sizes 1-20" `Quick
307
+
test_consistency_all_sizes;
308
+
Alcotest.test_case "consistency: same size" `Quick
309
+
test_consistency_same_size;
310
+
Alcotest.test_case "consistency: tampered rejects" `Quick
311
+
test_consistency_tampered_rejects;
312
+
Alcotest.test_case "consistency: power-of-2 sizes" `Quick
313
+
test_consistency_power_of_2;
314
+
Alcotest.test_case "consistency: RFC 9162 §2.1.5 vectors" `Quick
315
+
test_rfc9162_s215_consistency_vectors;
169
316
] )