Supply Chain Integrity, Transparency, and Trust (IETF SCITT)
Use date-hash version format in bottler (e.g. 20260401-b15a084)
Multiple releases per day now get unique versions. The git short
hash makes each release traceable to the exact commit. Comparing
versions: date gives chronological order, hash gives exact source.
+52
-55
+7
-5
lib/hash.ml
+7
-5
lib/hash.ml
···
26
26
Fun.protect
27
27
~finally:(fun () -> Mutex.unlock vds_mutex)
28
28
(fun () ->
29
-
if Hashtbl.mem vds_registry h.id then
30
-
invalid_arg
31
-
(Fmt.str "Scitt.register_hash: algorithm_id %d already registered"
32
-
h.id);
33
-
Hashtbl.add vds_registry h.id
29
+
Hashtbl.replace vds_registry h.id
34
30
{ hash = h; proof_format; subject_to_repo_key })
31
+
32
+
let unregister id =
33
+
Mutex.lock vds_mutex;
34
+
Fun.protect
35
+
~finally:(fun () -> Mutex.unlock vds_mutex)
36
+
(fun () -> Hashtbl.remove vds_registry id)
35
37
36
38
let find id =
37
39
Mutex.lock vds_mutex;
+6
-1
lib/hash.mli
+6
-1
lib/hash.mli
···
27
27
t ->
28
28
unit
29
29
(** [register ?proof_format ?subject_to_repo_key h] adds [h] to the global VDS
30
-
registry. *)
30
+
registry. Idempotent: re-registering the same [id] replaces the previous
31
+
entry. Safe to call from module initializers and concurrent contexts. *)
32
+
33
+
val unregister : int -> unit
34
+
(** [unregister id] removes algorithm [id] from the registry. No-op if not
35
+
registered. Useful for test isolation. *)
31
36
32
37
val find : int -> t option
33
38
(** [find id] looks up a registered hash by [id]. *)
-3
lib/vds.ml
-3
lib/vds.ml
+1
test/atp/dune
+1
test/atp/dune
+3
-1
test/atp/test.ml
+3
-1
test/atp/test.ml
+1
test/test.ml
+1
test/test.ml
+34
-45
test/test_vds.ml
+34
-45
test/test_vds.ml
···
98
98
(Scitt.vds_root reimported)
99
99
done
100
100
101
-
let test_multicore_append () =
102
-
(* Stress test: 4 domains appending concurrently. The Mutex inside the
103
-
backend must prevent data corruption. After all domains finish, the
104
-
tree size must equal the total number of appended entries and the
105
-
root must be deterministic (same as sequential append in sorted order). *)
101
+
let test_concurrent_append () =
102
+
(* Stress test: 4 fibers appending concurrently. The Eio.Mutex inside the
103
+
backend must prevent data corruption. After all fibers finish, the
104
+
tree size must equal the total number of appended entries. *)
106
105
let vds = Scitt.Vds_rfc9162.in_memory () in
107
-
let n_per_domain = 250 in
108
-
let n_domains = 4 in
109
-
let domains =
110
-
List.init n_domains (fun d ->
111
-
Domain.spawn (fun () ->
112
-
for i = 0 to n_per_domain - 1 do
113
-
let key = Fmt.str "d%d-k%d" d i in
114
-
ignore (Scitt.vds_append vds ~key ~value:key)
115
-
done))
116
-
in
117
-
List.iter Domain.join domains;
118
-
let total = n_domains * n_per_domain in
106
+
let n_per_fiber = 250 in
107
+
let n_fibers = 4 in
108
+
Eio.Fiber.all
109
+
(List.init n_fibers (fun d () ->
110
+
for i = 0 to n_per_fiber - 1 do
111
+
let key = Fmt.str "d%d-k%d" d i in
112
+
ignore (Scitt.vds_append vds ~key ~value:key)
113
+
done));
114
+
let total = n_fibers * n_per_fiber in
119
115
Alcotest.(check int) "total size" total (Scitt.vds_size vds);
120
-
(* Root must be non-empty *)
121
116
let root = Scitt.vds_root vds in
122
117
Alcotest.(check bool) "root not empty" true (String.length root > 0);
123
-
(* Verify all entries are present *)
124
-
for d = 0 to n_domains - 1 do
125
-
for i = 0 to n_per_domain - 1 do
118
+
for d = 0 to n_fibers - 1 do
119
+
for i = 0 to n_per_fiber - 1 do
126
120
let key = Fmt.str "d%d-k%d" d i in
127
121
Alcotest.(check bool)
128
122
(Fmt.str "found %s" key) true
···
130
124
done
131
125
done
132
126
133
-
let test_multicore_read_write () =
134
-
(* Readers and writers running concurrently. Writers append, readers
135
-
call root() and lookup(). No crashes, no corruption. *)
127
+
let test_concurrent_read_write () =
128
+
(* Readers and writers running concurrently as fibers. Writers append,
129
+
readers call root() and lookup(). No crashes, no corruption. *)
136
130
let vds = Scitt.Vds_rfc9162.in_memory () in
137
-
(* Pre-fill *)
138
131
for i = 0 to 99 do
139
132
ignore (Scitt.vds_append vds ~key:(Fmt.str "pre%d" i) ~value:"v")
140
133
done;
141
134
let writers =
142
-
List.init 2 (fun d ->
143
-
Domain.spawn (fun () ->
144
-
for i = 0 to 199 do
145
-
let key = Fmt.str "w%d-%d" d i in
146
-
ignore (Scitt.vds_append vds ~key ~value:key)
147
-
done))
135
+
List.init 2 (fun d () ->
136
+
for i = 0 to 199 do
137
+
let key = Fmt.str "w%d-%d" d i in
138
+
ignore (Scitt.vds_append vds ~key ~value:key)
139
+
done)
148
140
in
149
141
let readers =
150
-
List.init 2 (fun _d ->
151
-
Domain.spawn (fun () ->
152
-
for _ = 0 to 999 do
153
-
ignore (Scitt.vds_root vds);
154
-
ignore (Scitt.vds_lookup vds ~key:"pre50");
155
-
ignore (Scitt.vds_size vds)
156
-
done))
142
+
List.init 2 (fun _ () ->
143
+
for _ = 0 to 999 do
144
+
ignore (Scitt.vds_root vds);
145
+
ignore (Scitt.vds_lookup vds ~key:"pre50");
146
+
ignore (Scitt.vds_size vds)
147
+
done)
157
148
in
158
-
List.iter Domain.join writers;
159
-
List.iter Domain.join readers;
160
-
(* All writes landed *)
149
+
Eio.Fiber.all (writers @ readers);
161
150
Alcotest.(check int) "final size" 500 (Scitt.vds_size vds)
162
151
163
152
let suite =
···
173
162
test_import_rejects_bad_version;
174
163
Alcotest.test_case "vds: root consistency 0-100 entries" `Quick
175
164
test_root_consistency_various_sizes;
176
-
Alcotest.test_case "vds: multicore append (4 domains)" `Quick
177
-
test_multicore_append;
178
-
Alcotest.test_case "vds: multicore read+write" `Quick
179
-
test_multicore_read_write;
165
+
Alcotest.test_case "vds: concurrent append (4 fibers)" `Quick
166
+
test_concurrent_append;
167
+
Alcotest.test_case "vds: concurrent read+write" `Quick
168
+
test_concurrent_read_write;
180
169
] )