upstream: github.com/mirleft/ocaml-tls
feat(ocaml-tls): add key rotation and roundtrip fuzz/property tests
Protocol fuzz (fuzz/fuzz_tls.ml):
- Add roundtrip property tests for alert, version, handshake, certificates,
DH parameters, and digitally-signed: parse -> assemble -> parse must yield
the same value
- Add targeted key_update_roundtrip test exercising both UPDATE_REQUESTED
and UPDATE_NOT_REQUESTED paths (TLS 1.3 key rotation)
Eio fuzz (eio/tests/fuzz/fuzz_tls.ml):
- Add Key_update op to exercise TLS 1.3 key rotation mid-connection,
with request=true/false to cover both peer-update-request variants
+102
-1
+12
-1
eio/tests/fuzz/fuzz_tls.ml
+12
-1
eio/tests/fuzz/fuzz_tls.ml
···
40
40
| Transmit of transmit_amount (* The network sends some types to the peer *)
41
41
| Recv (* The application tries to read some data *)
42
42
| Shutdown_send (* The application shuts down the sending side *)
43
+
| Key_update of
44
+
bool (* TLS 1.3: update session keys; bool = request peer update *)
43
45
44
46
let label name gen = Crowbar.with_printer Fmt.(const string name) gen
45
47
···
50
52
Crowbar.(map [ range ~min:1 4096 ]) (fun n -> Transmit (`Bytes n));
51
53
label "recv" @@ Crowbar.const Recv;
52
54
label "shutdown-send" @@ Crowbar.const Shutdown_send;
55
+
Crowbar.(map [ bool ]) (fun req -> Key_update req);
53
56
]
54
57
55
58
type dir = To_client | To_server
···
109
112
receiver : Tls_eio.t Promise.or_exn;
110
113
mutable sent : int; (* Bytes of [message] sent so far *)
111
114
mutable recv : int; (* Bytes of [message] received so far *)
112
-
send_commands : [ `Send of int | `Exit ] Eio.Stream.t;
115
+
send_commands : [ `Send of int | `Key_update of bool | `Exit ] Eio.Stream.t;
113
116
(* Commands for the sending fiber *)
114
117
recv_commands : [ `Recv | `Drain ] Eio.Stream.t;
115
118
(* Commands for the receiving fiber *)
···
150
153
| `Exit ->
151
154
Log.info (fun f -> f "%a: shutdown send (Tls level)" pp_dir t);
152
155
Eio.Flow.shutdown sender `Send
156
+
| `Key_update req ->
157
+
Log.info (fun f -> f "%a: key_update request=%b" pp_dir t req);
158
+
(try Tls_eio.key_update ~request:req sender
159
+
with Invalid_argument _ -> ());
160
+
aux ()
153
161
| `Send len ->
154
162
let available = String.length t.message - t.sent in
155
163
let len = min len available in
···
212
220
| Shutdown_send ->
213
221
Log.info (fun f -> f "%a: enqueue shutdown send" pp_dir t);
214
222
shutdown t
223
+
| Key_update req ->
224
+
Log.info (fun f -> f "%a: enqueue key_update request=%b" pp_dir t req);
225
+
Eio.Stream.add t.send_commands @@ `Key_update req
215
226
end
216
227
217
228
module Config : sig
+90
fuzz/fuzz_tls.ml
+90
fuzz/fuzz_tls.ml
···
151
151
(match Tls.Reader.parse_record record with Ok _ | Error _ -> ());
152
152
()
153
153
154
+
(** Alert roundtrip: parse -> assemble -> parse must yield the same value. *)
155
+
let test_alert_roundtrip buf =
156
+
let buf = truncate ~max_len:256 buf in
157
+
match Tls.Reader.parse_alert buf with
158
+
| Error _ -> ()
159
+
| Ok (level, typ) -> (
160
+
let buf2 = Tls.Writer.assemble_alert ~level typ in
161
+
match Tls.Reader.parse_alert buf2 with
162
+
| Error _ -> Crowbar.fail "alert roundtrip: re-parse failed"
163
+
| Ok v2 -> Crowbar.check ((level, typ) = v2))
164
+
165
+
(** Version roundtrip: parse -> assemble -> parse must yield the same value. *)
166
+
let test_version_roundtrip buf =
167
+
let buf = truncate ~max_len:8 buf in
168
+
match Tls.Reader.parse_version buf with
169
+
| Error _ -> ()
170
+
| Ok v -> (
171
+
let buf2 = Tls.Writer.assemble_protocol_version v in
172
+
match Tls.Reader.parse_version buf2 with
173
+
| Error _ -> Crowbar.fail "version roundtrip: re-parse failed"
174
+
| Ok v2 -> Crowbar.check (v = v2))
175
+
176
+
(** Handshake roundtrip: parse -> assemble -> parse must yield the same value.
177
+
Covers all handshake message types including KeyUpdate (TLS 1.3) and
178
+
SessionTicket. *)
179
+
let test_handshake_roundtrip buf =
180
+
let buf = truncate buf in
181
+
match Tls.Reader.parse_handshake buf with
182
+
| Error _ -> ()
183
+
| Ok hs -> (
184
+
let buf2 = Tls.Writer.assemble_handshake hs in
185
+
match Tls.Reader.parse_handshake buf2 with
186
+
| Error _ -> Crowbar.fail "handshake roundtrip: re-parse failed"
187
+
| Ok hs2 -> Crowbar.check (hs = hs2))
188
+
189
+
(** Certificates roundtrip: parse -> assemble -> parse. *)
190
+
let test_certificates_roundtrip buf =
191
+
let buf = truncate ~max_len:8192 buf in
192
+
match Tls.Reader.parse_certificates buf with
193
+
| Error _ -> ()
194
+
| Ok certs -> (
195
+
let buf2 = Tls.Writer.assemble_certificates certs in
196
+
match Tls.Reader.parse_certificates buf2 with
197
+
| Error _ -> Crowbar.fail "certificates roundtrip: re-parse failed"
198
+
| Ok certs2 -> Crowbar.check (certs = certs2))
199
+
200
+
(** DH parameters roundtrip: parse -> assemble -> parse. *)
201
+
let test_dh_params_roundtrip buf =
202
+
let buf = truncate ~max_len:2048 buf in
203
+
match Tls.Reader.parse_dh_parameters buf with
204
+
| Error _ -> ()
205
+
| Ok (params, _, _) -> (
206
+
let buf2 = Tls.Writer.assemble_dh_parameters params in
207
+
match Tls.Reader.parse_dh_parameters buf2 with
208
+
| Error _ -> Crowbar.fail "DH params roundtrip: re-parse failed"
209
+
| Ok (params2, _, _) -> Crowbar.check (params = params2))
210
+
211
+
(** Digitally signed roundtrip (pre-1.2): parse -> assemble -> parse. *)
212
+
let test_digitally_signed_roundtrip buf =
213
+
let buf = truncate ~max_len:1024 buf in
214
+
match Tls.Reader.parse_digitally_signed buf with
215
+
| Error _ -> ()
216
+
| Ok sig_ -> (
217
+
let buf2 = Tls.Writer.assemble_digitally_signed sig_ in
218
+
match Tls.Reader.parse_digitally_signed buf2 with
219
+
| Error _ -> Crowbar.fail "digitally signed roundtrip: re-parse failed"
220
+
| Ok sig2 -> Crowbar.check (sig_ = sig2))
221
+
222
+
(** KeyUpdate roundtrip: construct known KeyUpdate handshake messages and verify
223
+
they survive a parse/assemble/parse cycle. CVE-2021-3449 involved
224
+
renegotiation/key-update handling. *)
225
+
let test_key_update_roundtrip req =
226
+
let hs =
227
+
Tls.Core.KeyUpdate
228
+
(if req then Tls.Packet.UPDATE_REQUESTED
229
+
else Tls.Packet.UPDATE_NOT_REQUESTED)
230
+
in
231
+
let buf = Tls.Writer.assemble_handshake hs in
232
+
match Tls.Reader.parse_handshake buf with
233
+
| Error _ -> Crowbar.fail "key_update roundtrip: parse failed"
234
+
| Ok hs2 -> Crowbar.check (hs = hs2)
235
+
154
236
(** Test record overflow detection. CVE-2014-0160 (Heartbleed) exploited missing
155
237
length validation. *)
156
238
let test_record_overflow claimed_len buf =
···
200
282
test_case "certificates 1.3" [ bytes ] test_certificates_1_3;
201
283
test_case "record content types" [ int; bytes ] test_record_content_types;
202
284
test_case "record overflow" [ int; bytes ] test_record_overflow;
285
+
test_case "alert roundtrip" [ bytes ] test_alert_roundtrip;
286
+
test_case "version roundtrip" [ bytes ] test_version_roundtrip;
287
+
test_case "handshake roundtrip" [ bytes ] test_handshake_roundtrip;
288
+
test_case "certificates roundtrip" [ bytes ] test_certificates_roundtrip;
289
+
test_case "DH params roundtrip" [ bytes ] test_dh_params_roundtrip;
290
+
test_case "digitally signed roundtrip" [ bytes ]
291
+
test_digitally_signed_roundtrip;
292
+
test_case "key update roundtrip" [ bool ] test_key_update_roundtrip;
203
293
] )