upstream: github.com/mirleft/ocaml-tls
fix(E606/E620): consolidate test stanzas, remove ounit2, fix testlib conflict
- tls/tests: merge → single test.ml runner, remove ounit2, convert to alcotest
- tls/eio/tests: add crypto-rng dep (E606), add test_rng.mli
- tls/test: move testlib to test/helpers/ (named test_helpers) to fix naming
conflict; merge 10 stanzas → single test_core stanza without (modules)
- tls/test/eio: merge 2 stanzas → 1
- tomlt/test: merge 2 stanzas → single test.ml; expose suite in .mli files
- tcf/test: merge 2 stanzas → single test.ml; convert runners to suite values
+707
-37
+1
-1
eio/tests/dune
+1
-1
eio/tests/dune
+11
eio/tests/test_rng.mli
+11
eio/tests/test_rng.mli
···
1
+
(* Insecure predictable RNG for fuzz testing. *)
2
+
3
+
type g = int ref
4
+
5
+
val block : int
6
+
val v : ?time:(unit -> int64) -> unit -> g
7
+
val generate_into : g:g -> bytes -> off:int -> int -> unit
8
+
val reseed : g:g -> string -> unit
9
+
val accumulate : g:g -> Crypto_rng.Entropy.source -> [ `Acc of string -> unit ]
10
+
val seeded : g:g -> bool
11
+
val pools : int
+17
test/dune
+17
test/dune
+5
test/eio/dune
+5
test/eio/dune
+5
test/helpers/dune
+5
test/helpers/dune
+80
test/helpers/testlib.ml
+80
test/helpers/testlib.ml
···
1
+
let () = Crypto_rng_unix.use_default ()
2
+
3
+
let time f =
4
+
let t1 = Sys.time () in
5
+
let r = f () in
6
+
let t2 = Sys.time () in
7
+
Printf.eprintf "[time] %f.04 s\n%!" (t2 -. t1);
8
+
r
9
+
10
+
let list_to_cstruct xs =
11
+
let buf = Bytes.create (List.length xs) in
12
+
List.iteri (Bytes.set_uint8 buf) xs;
13
+
Bytes.unsafe_to_string buf
14
+
15
+
let uint16_to_cstruct i =
16
+
let buf = Bytes.create 2 in
17
+
Bytes.set_uint16_be buf 0 i;
18
+
buf
19
+
20
+
let hexdump_to_str cs = Ohex.encode cs
21
+
22
+
(* OUnit2 compatibility shims *)
23
+
24
+
let assert_failure msg = Alcotest.fail msg
25
+
26
+
let assert_equal ?cmp ?printer ?msg expected actual =
27
+
let equal =
28
+
match cmp with Some f -> f expected actual | None -> expected = actual
29
+
in
30
+
if not equal then
31
+
match (printer, msg) with
32
+
| Some p, Some m ->
33
+
Alcotest.failf "%s: expected %s, got %s" m (p expected) (p actual)
34
+
| Some p, None ->
35
+
Alcotest.failf "expected %s, got %s" (p expected) (p actual)
36
+
| None, Some m -> Alcotest.fail m
37
+
| None, None -> Alcotest.fail "assert_equal"
38
+
39
+
let assert_bool msg b = if not b then Alcotest.fail msg
40
+
let ( >:: ) name f = (name, `Quick, fun () -> f ())
41
+
42
+
let assert_cs_eq ?msg cs1 cs2 =
43
+
assert_equal ~cmp:String.equal ~printer:hexdump_to_str ?msg cs1 cs2
44
+
45
+
let rec assert_lists_eq comparison a b =
46
+
match (a, b) with
47
+
| [], [] -> ()
48
+
| a :: r1, b :: r2 ->
49
+
comparison a b;
50
+
assert_lists_eq comparison r1 r2
51
+
| _ -> assert_failure "lists not equal"
52
+
53
+
let assert_sessionid_equal a b =
54
+
match (a, b) with
55
+
| None, None -> ()
56
+
| Some x, Some y -> assert_cs_eq x y
57
+
| _ -> assert_failure "session id not equal"
58
+
59
+
let assert_client_extension_equal a b =
60
+
match (a, b) with
61
+
| `Hostname a, `Hostname b -> assert_equal a b
62
+
| `MaxFragmentLength a, `MaxFragmentLength b -> assert_equal a b
63
+
| `SupportedGroups a, `SupportedGroups b -> assert_lists_eq assert_equal a b
64
+
| `SecureRenegotiation a, `SecureRenegotiation b -> assert_cs_eq a b
65
+
| `Padding a, `Padding b -> assert_equal a b
66
+
| `SignatureAlgorithms a, `SignatureAlgorithms b ->
67
+
assert_lists_eq (fun sa sa' -> assert_equal sa sa') a b
68
+
| `ALPN a, `ALPN b -> assert_lists_eq assert_equal a b
69
+
| _ -> assert_failure "extensions did not match"
70
+
71
+
let assert_server_extension_equal a b =
72
+
match (a, b) with
73
+
| `Hostname, `Hostname -> ()
74
+
| `MaxFragmentLength a, `MaxFragmentLength b -> assert_equal a b
75
+
| `SecureRenegotiation a, `SecureRenegotiation b -> assert_cs_eq a b
76
+
| `ALPN a, `ALPN b -> assert_equal a b
77
+
| _ -> assert_failure "extensions did not match"
78
+
79
+
let make_hostname_ext h =
80
+
`Hostname (Domain_name.of_string_exn h |> Domain_name.host_exn)
+532
test/test_packet.ml
+532
test/test_packet.ml
···
1
+
open Tls
2
+
open Testlib
3
+
4
+
let readerwriter_version v _ =
5
+
let buf = Writer.assemble_protocol_version v in
6
+
match Reader.parse_version buf with
7
+
| Ok ver -> (
8
+
assert_equal v ver;
9
+
(* lets get crazy and do it one more time *)
10
+
let buf' = Writer.assemble_protocol_version v in
11
+
match Reader.parse_version buf' with
12
+
| Ok ver' -> assert_equal v ver'
13
+
| Error _ -> assert_failure "read and write version broken")
14
+
| Error _ -> assert_failure "read and write version broken"
15
+
16
+
let version_tests =
17
+
[
18
+
"ReadWrite version TLS-1.0" >:: readerwriter_version `TLS_1_0;
19
+
"ReadWrite version TLS-1.1" >:: readerwriter_version `TLS_1_1;
20
+
"ReadWrite version TLS-1.2" >:: readerwriter_version `TLS_1_2;
21
+
]
22
+
23
+
let readerwriter_header (v, ct, cs) _ =
24
+
let buf = Writer.assemble_hdr v (ct, cs) in
25
+
match Reader.parse_record buf with
26
+
| Ok (`Record ((hdr, payload), f)) -> (
27
+
let open Core in
28
+
assert_equal 0 (String.length f);
29
+
assert_equal (v :> tls_any_version) hdr.version;
30
+
assert_equal ct hdr.content_type;
31
+
assert_cs_eq cs payload;
32
+
let buf' = Writer.assemble_hdr v (hdr.content_type, payload) in
33
+
match Reader.parse_record buf' with
34
+
| Ok (`Record ((hdr, payload), f)) ->
35
+
assert_equal 0 (String.length f);
36
+
assert_equal (v :> tls_any_version) hdr.version;
37
+
assert_equal ct hdr.content_type;
38
+
assert_cs_eq cs payload
39
+
| _ -> assert_failure "inner header broken")
40
+
| _ -> assert_failure "header broken"
41
+
42
+
let header_tests =
43
+
let a =
44
+
list_to_cstruct [ 0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15 ]
45
+
in
46
+
[
47
+
"ReadWrite header" >:: readerwriter_header (`TLS_1_0, Packet.HANDSHAKE, a);
48
+
"ReadWrite header" >:: readerwriter_header (`TLS_1_1, Packet.HANDSHAKE, a);
49
+
"ReadWrite header" >:: readerwriter_header (`TLS_1_2, Packet.HANDSHAKE, a);
50
+
"ReadWrite header"
51
+
>:: readerwriter_header (`TLS_1_0, Packet.APPLICATION_DATA, a);
52
+
"ReadWrite header"
53
+
>:: readerwriter_header (`TLS_1_1, Packet.APPLICATION_DATA, a);
54
+
"ReadWrite header"
55
+
>:: readerwriter_header (`TLS_1_2, Packet.APPLICATION_DATA, a);
56
+
"ReadWrite header"
57
+
>:: readerwriter_header (`TLS_1_0, Packet.CHANGE_CIPHER_SPEC, a);
58
+
"ReadWrite header"
59
+
>:: readerwriter_header (`TLS_1_1, Packet.CHANGE_CIPHER_SPEC, a);
60
+
"ReadWrite header"
61
+
>:: readerwriter_header (`TLS_1_2, Packet.CHANGE_CIPHER_SPEC, a);
62
+
"ReadWrite header" >:: readerwriter_header (`TLS_1_0, Packet.ALERT, a);
63
+
"ReadWrite header" >:: readerwriter_header (`TLS_1_1, Packet.ALERT, a);
64
+
"ReadWrite header" >:: readerwriter_header (`TLS_1_2, Packet.ALERT, a);
65
+
]
66
+
67
+
let readerwriter_alert (lvl, typ) _ =
68
+
let buf, expl =
69
+
match lvl with
70
+
| None -> (Writer.assemble_alert typ, Packet.FATAL)
71
+
| Some l -> (Writer.assemble_alert ~level:l typ, l)
72
+
in
73
+
match Reader.parse_alert buf with
74
+
| Ok (l', t') -> (
75
+
assert_equal expl l';
76
+
assert_equal typ t';
77
+
(* lets get crazy and do it one more time *)
78
+
let buf' = Writer.assemble_alert ~level:l' t' in
79
+
match Reader.parse_alert buf' with
80
+
| Ok (l'', t'') ->
81
+
assert_equal expl l'';
82
+
assert_equal typ t''
83
+
| Error _ -> assert_failure "inner read and write alert broken")
84
+
| Error _ -> assert_failure "read and write alert broken"
85
+
86
+
let rw_alert_tests =
87
+
Packet.
88
+
[
89
+
(None, CLOSE_NOTIFY);
90
+
(None, UNEXPECTED_MESSAGE);
91
+
(None, BAD_RECORD_MAC);
92
+
(None, RECORD_OVERFLOW);
93
+
(None, HANDSHAKE_FAILURE);
94
+
(None, BAD_CERTIFICATE);
95
+
(None, CERTIFICATE_EXPIRED);
96
+
(None, DECODE_ERROR);
97
+
(None, PROTOCOL_VERSION);
98
+
(None, UNSUPPORTED_EXTENSION);
99
+
(None, UNRECOGNIZED_NAME);
100
+
(None, NO_APPLICATION_PROTOCOL);
101
+
(Some FATAL, CLOSE_NOTIFY);
102
+
(Some FATAL, UNEXPECTED_MESSAGE);
103
+
(Some FATAL, BAD_RECORD_MAC);
104
+
(Some FATAL, RECORD_OVERFLOW);
105
+
(Some FATAL, HANDSHAKE_FAILURE);
106
+
(Some FATAL, BAD_CERTIFICATE);
107
+
(Some FATAL, CERTIFICATE_EXPIRED);
108
+
(Some FATAL, DECODE_ERROR);
109
+
(Some FATAL, PROTOCOL_VERSION);
110
+
(Some FATAL, UNSUPPORTED_EXTENSION);
111
+
(Some FATAL, UNRECOGNIZED_NAME);
112
+
(Some FATAL, NO_APPLICATION_PROTOCOL);
113
+
(Some WARNING, CLOSE_NOTIFY);
114
+
(* ( Some WARNING, UNEXPECTED_MESSAGE ) ;
115
+
( Some WARNING, BAD_RECORD_MAC ) ;
116
+
( Some WARNING, DECRYPTION_FAILED ) ;
117
+
( Some WARNING, RECORD_OVERFLOW ) ;
118
+
( Some WARNING, DECOMPRESSION_FAILURE ) ;
119
+
( Some WARNING, HANDSHAKE_FAILURE ) ; *)
120
+
(Some FATAL, BAD_CERTIFICATE);
121
+
(Some FATAL, CERTIFICATE_EXPIRED);
122
+
(* ( Some WARNING, UNKNOWN_CA ) ;
123
+
( Some WARNING, ACCESS_DENIED ) ;
124
+
( Some WARNING, DECODE_ERROR ) ;
125
+
( Some WARNING, DECRYPT_ERROR ) ; *)
126
+
(* ( Some WARNING, PROTOCOL_VERSION ) ;
127
+
( Some WARNING, INSUFFICIENT_SECURITY ) ;
128
+
( Some WARNING, INTERNAL_ERROR ) ; *)
129
+
(Some WARNING, USER_CANCELED);
130
+
(Some WARNING, NO_RENEGOTIATION);
131
+
(* ( Some WARNING, UNSUPPORTED_EXTENSION ) ; *)
132
+
(Some FATAL, UNRECOGNIZED_NAME);
133
+
]
134
+
135
+
let rw_alert_tests =
136
+
List.mapi
137
+
(fun i f -> "RW alert " ^ string_of_int i >:: readerwriter_alert f)
138
+
rw_alert_tests
139
+
140
+
let assert_dh_eq a b =
141
+
Core.(assert_cs_eq a.dh_p b.dh_p);
142
+
Core.(assert_cs_eq a.dh_g b.dh_g);
143
+
Core.(assert_cs_eq a.dh_Ys b.dh_Ys)
144
+
145
+
let readerwriter_dh_params params _ =
146
+
let buf = Writer.assemble_dh_parameters params in
147
+
match Reader.parse_dh_parameters buf with
148
+
| Ok (p, raw, rst) -> (
149
+
assert_equal (String.length rst) 0;
150
+
assert_dh_eq p params;
151
+
assert_equal buf raw;
152
+
(* lets get crazy and do it one more time *)
153
+
let buf' = Writer.assemble_dh_parameters p in
154
+
match Reader.parse_dh_parameters buf' with
155
+
| Ok (p', raw', rst') ->
156
+
assert_equal (String.length rst') 0;
157
+
assert_dh_eq p' params;
158
+
assert_equal buf raw'
159
+
| Error _ -> assert_failure "inner read and write dh params broken")
160
+
| Error _ -> assert_failure "read and write dh params broken"
161
+
162
+
let rw_dh_params =
163
+
let a =
164
+
list_to_cstruct [ 0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15 ]
165
+
in
166
+
let emp = list_to_cstruct [] in
167
+
Core.
168
+
[
169
+
{ dh_p = emp; dh_g = emp; dh_Ys = emp };
170
+
{ dh_p = a; dh_g = emp; dh_Ys = emp };
171
+
{ dh_p = emp; dh_g = a; dh_Ys = emp };
172
+
{ dh_p = emp; dh_g = emp; dh_Ys = a };
173
+
{ dh_p = a ^ a; dh_g = a ^ a; dh_Ys = a ^ a };
174
+
]
175
+
176
+
let rw_dh_tests =
177
+
List.mapi
178
+
(fun i f -> "RW dh_param " ^ string_of_int i >:: readerwriter_dh_params f)
179
+
rw_dh_params
180
+
181
+
let readerwriter_digitally_signed params _ =
182
+
let buf = Writer.assemble_digitally_signed params in
183
+
match Reader.parse_digitally_signed buf with
184
+
| Ok params' -> (
185
+
assert_cs_eq params params';
186
+
(* lets get crazy and do it one more time *)
187
+
let buf' = Writer.assemble_digitally_signed params' in
188
+
match Reader.parse_digitally_signed buf' with
189
+
| Ok params'' -> assert_cs_eq params params''
190
+
| Error _ -> assert_failure "inner read and write digitally signed broken"
191
+
)
192
+
| Error _ -> assert_failure "read and write digitally signed broken"
193
+
194
+
let rw_ds_params =
195
+
let a =
196
+
list_to_cstruct [ 0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15 ]
197
+
in
198
+
let emp = list_to_cstruct [] in
199
+
[ a; a ^ a; emp; emp ^ a ]
200
+
201
+
let rw_ds_tests =
202
+
List.mapi
203
+
(fun i f ->
204
+
"RW digitally signed " ^ string_of_int i
205
+
>:: readerwriter_digitally_signed f)
206
+
rw_ds_params
207
+
208
+
let readerwriter_digitally_signed_1_2 (sigalg, params) _ =
209
+
let buf = Writer.assemble_digitally_signed_1_2 sigalg params in
210
+
match Reader.parse_digitally_signed_1_2 buf with
211
+
| Ok (sigalg', params') -> (
212
+
assert_equal sigalg sigalg';
213
+
assert_cs_eq params params';
214
+
(* lets get crazy and do it one more time *)
215
+
let buf' = Writer.assemble_digitally_signed_1_2 sigalg' params' in
216
+
match Reader.parse_digitally_signed_1_2 buf' with
217
+
| Ok (sigalg'', params'') ->
218
+
assert_equal sigalg sigalg'';
219
+
assert_cs_eq params params''
220
+
| Error _ ->
221
+
assert_failure "inner read and write digitally signed 1.2 broken")
222
+
| Error _ -> assert_failure "read and write digitally signed 1.2 broken"
223
+
224
+
let rec cartesian_product f a b =
225
+
match b with
226
+
| [] -> []
227
+
| e :: rt -> List.map (fun x -> f x e) a @ cartesian_product f a rt
228
+
229
+
let rw_ds_1_2_params =
230
+
let a =
231
+
list_to_cstruct [ 0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15 ]
232
+
in
233
+
let emp = list_to_cstruct [] in
234
+
let cs = [ a; a ^ a; emp; emp ^ a ] in
235
+
let sig_algs =
236
+
[
237
+
`RSA_PKCS1_MD5;
238
+
`RSA_PKCS1_SHA1;
239
+
`RSA_PKCS1_SHA224;
240
+
`RSA_PKCS1_SHA256;
241
+
`RSA_PKCS1_SHA384;
242
+
`RSA_PKCS1_SHA512;
243
+
`RSA_PSS_RSAENC_SHA256;
244
+
`RSA_PSS_RSAENC_SHA384;
245
+
`RSA_PSS_RSAENC_SHA512;
246
+
]
247
+
in
248
+
cartesian_product (fun sigalg c -> (sigalg, c)) sig_algs cs
249
+
250
+
let rw_ds_1_2_tests =
251
+
List.mapi
252
+
(fun i f ->
253
+
"RW digitally signed 1.2 " ^ string_of_int i
254
+
>:: readerwriter_digitally_signed_1_2 f)
255
+
rw_ds_1_2_params
256
+
257
+
let rw_handshake_no_data hs _ =
258
+
let buf = Writer.assemble_handshake hs in
259
+
match Reader.parse_handshake buf with
260
+
| Ok hs' -> (
261
+
assert_equal hs hs';
262
+
(* lets get crazy and do it one more time *)
263
+
let buf' = Writer.assemble_handshake hs' in
264
+
match Reader.parse_handshake buf' with
265
+
| Ok hs'' -> assert_equal hs hs''
266
+
| Error _ -> assert_failure "handshake no data inner failed")
267
+
| Error _ -> assert_failure "handshake no data failed"
268
+
269
+
let rw_handshakes_no_data_vals = [ Core.HelloRequest; Core.ServerHelloDone ]
270
+
271
+
let rw_handshake_no_data_tests =
272
+
List.mapi
273
+
(fun i f ->
274
+
"handshake no data " ^ string_of_int i >:: rw_handshake_no_data f)
275
+
rw_handshakes_no_data_vals
276
+
277
+
let rw_handshake_cstruct_data hs _ =
278
+
let buf = Writer.assemble_handshake hs in
279
+
match Reader.parse_handshake buf with
280
+
| Ok hs' -> (
281
+
Test_reader.cmp_handshake_cstruct hs hs';
282
+
(* lets get crazy and do it one more time *)
283
+
let buf' = Writer.assemble_handshake hs' in
284
+
match Reader.parse_handshake buf' with
285
+
| Ok hs'' -> Test_reader.cmp_handshake_cstruct hs hs''
286
+
| Error _ -> assert_failure "handshake cstruct data inner failed")
287
+
| Error _ -> assert_failure "handshake cstruct data failed"
288
+
289
+
let rw_handshake_cstruct_data_vals =
290
+
let data_cs = list_to_cstruct [ 0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11 ] in
291
+
let emp = list_to_cstruct [] in
292
+
Core.
293
+
[
294
+
ServerKeyExchange emp;
295
+
ServerKeyExchange data_cs;
296
+
Finished emp;
297
+
Finished data_cs;
298
+
ClientKeyExchange emp;
299
+
ClientKeyExchange data_cs;
300
+
Certificate (Writer.assemble_certificates []);
301
+
Certificate (Writer.assemble_certificates [ data_cs ]);
302
+
Certificate (Writer.assemble_certificates [ data_cs; data_cs ]);
303
+
Certificate (Writer.assemble_certificates [ data_cs; emp ]);
304
+
Certificate (Writer.assemble_certificates [ emp; data_cs ]);
305
+
Certificate (Writer.assemble_certificates [ emp; data_cs; emp ]);
306
+
Certificate (Writer.assemble_certificates [ emp; data_cs; emp; data_cs ]);
307
+
]
308
+
309
+
let rw_handshake_cstruct_data_tests =
310
+
List.mapi
311
+
(fun i f ->
312
+
"handshake cstruct data " ^ string_of_int i
313
+
>:: rw_handshake_cstruct_data f)
314
+
rw_handshake_cstruct_data_vals
315
+
316
+
let rw_handshake_client_hello hs _ =
317
+
let buf = Writer.assemble_handshake hs in
318
+
match Reader.parse_handshake buf with
319
+
| Ok hs' -> (
320
+
Core.(
321
+
match (hs, hs') with
322
+
| ClientHello ch, ClientHello ch' ->
323
+
Test_reader.cmp_client_hellos ch ch'
324
+
| _ -> assert_failure "handshake client hello broken");
325
+
(* lets get crazy and do it one more time *)
326
+
let buf' = Writer.assemble_handshake hs' in
327
+
match Reader.parse_handshake buf' with
328
+
| Ok hs'' -> (
329
+
Core.(
330
+
match (hs, hs'') with
331
+
| ClientHello ch, ClientHello ch'' ->
332
+
Test_reader.cmp_client_hellos ch ch''
333
+
| _ -> assert_failure "handshake client hello broken"))
334
+
| Error _ -> assert_failure "handshake client hello inner failed")
335
+
| Error _ -> assert_failure "handshake client hello failed"
336
+
337
+
let rw_handshake_client_hello_vals =
338
+
let rnd = [ 0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15 ] in
339
+
let client_random = list_to_cstruct (rnd @ rnd) in
340
+
Core.(
341
+
let ch : client_hello =
342
+
{
343
+
client_version = `TLS_1_2;
344
+
client_random;
345
+
sessionid = None;
346
+
ciphersuites = [];
347
+
extensions = [];
348
+
}
349
+
in
350
+
[
351
+
ClientHello ch;
352
+
ClientHello { ch with client_version = `TLS_1_0 };
353
+
ClientHello { ch with client_version = `TLS_1_1 };
354
+
ClientHello
355
+
{ ch with ciphersuites = [ Packet.TLS_RSA_WITH_3DES_EDE_CBC_SHA ] };
356
+
ClientHello
357
+
{
358
+
ch with
359
+
ciphersuites =
360
+
Packet.
361
+
[
362
+
TLS_RSA_WITH_3DES_EDE_CBC_SHA;
363
+
TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA;
364
+
TLS_RSA_WITH_AES_256_CBC_SHA;
365
+
];
366
+
};
367
+
ClientHello { ch with sessionid = Some (list_to_cstruct rnd) };
368
+
ClientHello { ch with sessionid = Some client_random };
369
+
ClientHello
370
+
{
371
+
ch with
372
+
ciphersuites =
373
+
Packet.
374
+
[
375
+
TLS_RSA_WITH_3DES_EDE_CBC_SHA;
376
+
TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA;
377
+
TLS_RSA_WITH_AES_256_CBC_SHA;
378
+
];
379
+
sessionid = Some client_random;
380
+
};
381
+
ClientHello { ch with extensions = [ make_hostname_ext "foobar" ] };
382
+
ClientHello { ch with extensions = [ make_hostname_ext "foobarblubb" ] };
383
+
ClientHello
384
+
{
385
+
ch with
386
+
extensions =
387
+
[
388
+
make_hostname_ext "foobarblubb";
389
+
`SupportedGroups Packet.[ SECP521R1; SECP384R1 ];
390
+
];
391
+
};
392
+
ClientHello { ch with extensions = [ `ALPN [ "h2"; "http/1.1" ] ] };
393
+
ClientHello
394
+
{
395
+
ch with
396
+
extensions =
397
+
[
398
+
make_hostname_ext "foobarblubb";
399
+
`SupportedGroups Packet.[ SECP521R1; SECP384R1 ];
400
+
`SignatureAlgorithms [ `RSA_PKCS1_MD5 ];
401
+
`ALPN [ "h2"; "http/1.1" ];
402
+
];
403
+
};
404
+
ClientHello
405
+
{
406
+
ch with
407
+
ciphersuites =
408
+
Packet.
409
+
[
410
+
TLS_RSA_WITH_3DES_EDE_CBC_SHA;
411
+
TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA;
412
+
TLS_RSA_WITH_AES_256_CBC_SHA;
413
+
];
414
+
sessionid = Some client_random;
415
+
extensions = [ make_hostname_ext "foobarblubb" ];
416
+
};
417
+
ClientHello
418
+
{
419
+
ch with
420
+
ciphersuites =
421
+
Packet.
422
+
[
423
+
TLS_RSA_WITH_3DES_EDE_CBC_SHA;
424
+
TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA;
425
+
TLS_RSA_WITH_AES_256_CBC_SHA;
426
+
];
427
+
sessionid = Some client_random;
428
+
extensions =
429
+
[
430
+
make_hostname_ext "foobarblubb";
431
+
`SupportedGroups Packet.[ SECP521R1; SECP384R1 ];
432
+
`SignatureAlgorithms [ `RSA_PKCS1_SHA1; `RSA_PKCS1_SHA512 ];
433
+
`ALPN [ "h2"; "http/1.1" ];
434
+
];
435
+
};
436
+
ClientHello
437
+
{
438
+
ch with
439
+
ciphersuites =
440
+
Packet.
441
+
[
442
+
TLS_RSA_WITH_3DES_EDE_CBC_SHA;
443
+
TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA;
444
+
TLS_RSA_WITH_AES_256_CBC_SHA;
445
+
];
446
+
sessionid = Some client_random;
447
+
extensions =
448
+
[
449
+
make_hostname_ext "foobarblubb";
450
+
`SupportedGroups Packet.[ SECP521R1; SECP384R1 ];
451
+
`SignatureAlgorithms [ `RSA_PKCS1_MD5; `RSA_PKCS1_SHA256 ];
452
+
`SecureRenegotiation client_random;
453
+
`ALPN [ "h2"; "http/1.1" ];
454
+
];
455
+
};
456
+
])
457
+
458
+
let rw_handshake_client_hello_tests =
459
+
List.mapi
460
+
(fun i f ->
461
+
"handshake client hello " ^ string_of_int i
462
+
>:: rw_handshake_client_hello f)
463
+
rw_handshake_client_hello_vals
464
+
465
+
let rw_handshake_server_hello hs _ =
466
+
let buf = Writer.assemble_handshake hs in
467
+
match Reader.parse_handshake buf with
468
+
| Ok hs' -> (
469
+
Core.(
470
+
match (hs, hs') with
471
+
| ServerHello sh, ServerHello sh' ->
472
+
Test_reader.cmp_server_hellos sh sh'
473
+
| _ -> assert_failure "handshake server hello broken");
474
+
(* lets get crazy and do it one more time *)
475
+
let buf' = Writer.assemble_handshake hs' in
476
+
match Reader.parse_handshake buf' with
477
+
| Ok hs'' -> (
478
+
Core.(
479
+
match (hs, hs'') with
480
+
| ServerHello sh, ServerHello sh'' ->
481
+
Test_reader.cmp_server_hellos sh sh''
482
+
| _ -> assert_failure "handshake server hello broken"))
483
+
| Error _ -> assert_failure "handshake server hello inner failed")
484
+
| Error _ -> assert_failure "handshake server hello failed"
485
+
486
+
let rw_handshake_server_hello_vals =
487
+
let rnd = [ 0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15 ] in
488
+
let server_random = list_to_cstruct (rnd @ rnd) in
489
+
Core.(
490
+
let sh : server_hello =
491
+
{
492
+
server_version = `TLS_1_2;
493
+
server_random;
494
+
sessionid = None;
495
+
ciphersuite = `RSA_WITH_AES_256_CCM;
496
+
extensions = [];
497
+
}
498
+
in
499
+
[
500
+
ServerHello sh;
501
+
ServerHello { sh with server_version = `TLS_1_0 };
502
+
ServerHello { sh with server_version = `TLS_1_1 };
503
+
ServerHello { sh with sessionid = Some server_random };
504
+
ServerHello
505
+
{ sh with sessionid = Some server_random; extensions = [ `Hostname ] };
506
+
ServerHello
507
+
{
508
+
sh with
509
+
sessionid = Some server_random;
510
+
extensions = [ `Hostname; `SecureRenegotiation server_random ];
511
+
};
512
+
ServerHello
513
+
{
514
+
sh with
515
+
sessionid = Some server_random;
516
+
extensions =
517
+
[ `Hostname; `SecureRenegotiation server_random; `ALPN "h2" ];
518
+
};
519
+
])
520
+
521
+
let rw_handshake_server_hello_tests =
522
+
List.mapi
523
+
(fun i f ->
524
+
"handshake server hello " ^ string_of_int i
525
+
>:: rw_handshake_server_hello f)
526
+
rw_handshake_server_hello_vals
527
+
528
+
let readerwriter_tests =
529
+
version_tests @ header_tests @ rw_alert_tests @ rw_dh_tests @ rw_ds_tests
530
+
@ rw_ds_1_2_tests @ rw_handshake_no_data_tests
531
+
@ rw_handshake_cstruct_data_tests @ rw_handshake_client_hello_tests
532
+
@ rw_handshake_server_hello_tests
+24
-13
tests/dune
+24
-13
tests/dune
···
1
1
(library
2
2
(name testlib)
3
3
(modules testlib)
4
-
(libraries tls ounit2 crypto-rng.unix)
4
+
(libraries tls alcotest crypto-rng.unix ohex domain-name)
5
5
(optional))
6
6
7
7
(test
8
-
(name unittestrunner)
8
+
(name test)
9
9
(package tls)
10
-
(modules readertests readerwritertests writertests unittests unittestrunner)
11
-
(libraries tls ounit2 testlib))
12
-
13
-
(test
14
-
(name key_derivation)
15
-
(package tls)
16
-
(modules key_derivation)
17
-
(libraries tls crypto-rng.unix alcotest logs.fmt))
10
+
(modules
11
+
test
12
+
unittests
13
+
readertests
14
+
readerwritertests
15
+
writertests
16
+
key_derivation)
17
+
(libraries
18
+
tls
19
+
testlib
20
+
crypto-rng.unix
21
+
alcotest
22
+
ohex
23
+
digestif
24
+
kdf.hkdf
25
+
crypto
26
+
crypto-ec
27
+
crypto-pk
28
+
x509
29
+
logs.fmt
30
+
fmt.tty))
18
31
19
-
(test
32
+
(executable
20
33
(name feedback)
21
-
(package tls)
22
34
(modules feedback)
23
-
(deps server.key server.pem)
24
35
(libraries tls x509 testlib cmdliner fmt.cli logs.fmt fmt.tty logs.cli))
+1
-7
tests/key_derivation.ml
+1
-7
tests/key_derivation.ml
···
831
831
("x25519", `Quick, x25519);
832
832
]
833
833
834
-
let () =
835
-
Fmt_tty.setup_std_outputs ();
836
-
Logs.set_level (Some Logs.Debug);
837
-
Logs.set_reporter (Logs_fmt.reporter ~dst:Format.std_formatter ());
838
-
Crypto_rng_unix.use_default ();
839
-
Alcotest.run "Key derivation tests"
840
-
[ ("key extraction and derivation", tests) ]
834
+
let suite = [ ("key extraction and derivation", tests) ]
-1
tests/readertests.ml
-1
tests/readertests.ml
-1
tests/readerwritertests.ml
-1
tests/readerwritertests.ml
+6
tests/test.ml
+6
tests/test.ml
+20
-2
tests/testlib.ml
+20
-2
tests/testlib.ml
···
1
-
open OUnit2
2
-
3
1
let () = Crypto_rng_unix.use_default ()
4
2
5
3
let time f =
···
20
18
buf
21
19
22
20
let hexdump_to_str cs = Ohex.encode cs
21
+
22
+
(* OUnit2 compatibility shims *)
23
+
24
+
let assert_failure msg = Alcotest.fail msg
25
+
26
+
let assert_equal ?cmp ?printer ?msg expected actual =
27
+
let equal =
28
+
match cmp with Some f -> f expected actual | None -> expected = actual
29
+
in
30
+
if not equal then
31
+
match (printer, msg) with
32
+
| Some p, Some m ->
33
+
Alcotest.failf "%s: expected %s, got %s" m (p expected) (p actual)
34
+
| Some p, None ->
35
+
Alcotest.failf "expected %s, got %s" (p expected) (p actual)
36
+
| None, Some m -> Alcotest.fail m
37
+
| None, None -> Alcotest.fail "assert_equal"
38
+
39
+
let assert_bool msg b = if not b then Alcotest.fail msg
40
+
let ( >:: ) name f = (name, `Quick, fun () -> f ())
23
41
24
42
let assert_cs_eq ?msg cs1 cs2 =
25
43
assert_equal ~cmp:String.equal ~printer:hexdump_to_str ?msg cs1 cs2
+5
-8
tests/unittests.ml
+5
-8
tests/unittests.ml
···
1
-
open OUnit2
2
-
3
1
let suite =
4
-
"All"
5
-
>::: [
6
-
"Reader" >::: Readertests.reader_tests;
7
-
"Writer" >::: Writertests.writer_tests;
8
-
"ReaderWriter" >::: Readerwritertests.readerwriter_tests;
9
-
]
2
+
[
3
+
("reader", Readertests.reader_tests);
4
+
("writer", Writertests.writer_tests);
5
+
("reader_writer", Readerwritertests.readerwriter_tests);
6
+
]