upstream: github.com/mirleft/ocaml-tls
refactor(crowbar): Alcotest-style API with suite exports and grouped run
- Change `run` signature to `string -> (string * test_case list) list -> unit`
matching Alcotest's grouping convention
- Fix `_name` bug: pass the name through to Alcotest.run_with_args
- Each fuzz module now exports `let suite = ("name", [test_case ...])`
- Entry points (fuzz.ml) collect suites: `Crowbar.run "pkg" [Fuzz_X.suite]`
- Remove stale `add_test`/`suite` API, keep only `test_case`/`run`
- Remove `let run () = ()` from fuzz_common.ml files
- Update merlint E725 rule to match new `let suite = ("name", ...)` pattern
- Update E725 test fixtures and expected output
+50
-47
+50
-47
fuzz/fuzz_tls.ml
+50
-47
fuzz/fuzz_tls.ml
···
28
28
Heartbleed was a buffer overread in record parsing. *)
29
29
let test_record_parse buf =
30
30
let buf = truncate buf in
31
-
(try ignore (Tls.Reader.parse_record buf) with _ -> ());
31
+
(match Tls.Reader.parse_record buf with Ok _ | Error _ -> ());
32
32
()
33
33
34
34
(** Handshake message parsing - must handle malformed handshakes. Many TLS
35
35
vulnerabilities involve malformed handshake messages. *)
36
36
let test_handshake_parse buf =
37
37
let buf = truncate buf in
38
-
(try ignore (Tls.Reader.parse_handshake buf) with _ -> ());
38
+
(match Tls.Reader.parse_handshake buf with Ok _ | Error _ -> ());
39
39
()
40
40
41
41
(** Handshake frame parsing - must not crash. *)
42
42
let test_handshake_frame buf =
43
43
let buf = truncate buf in
44
-
(try ignore (Tls.Reader.parse_handshake_frame buf) with _ -> ());
44
+
ignore (Tls.Reader.parse_handshake_frame buf);
45
45
()
46
46
47
47
(** Alert parsing - must handle invalid alert codes. *)
48
48
let test_alert_parse buf =
49
49
let buf = truncate ~max_len:256 buf in
50
-
(try ignore (Tls.Reader.parse_alert buf) with _ -> ());
50
+
(match Tls.Reader.parse_alert buf with Ok _ | Error _ -> ());
51
51
()
52
52
53
53
(** Change cipher spec parsing. *)
54
54
let test_change_cipher_spec buf =
55
55
let buf = truncate ~max_len:16 buf in
56
-
(try ignore (Tls.Reader.parse_change_cipher_spec buf) with _ -> ());
56
+
(match Tls.Reader.parse_change_cipher_spec buf with Ok _ | Error _ -> ());
57
57
()
58
58
59
59
(** Version parsing - must handle invalid versions. *)
60
60
let test_version_parse buf =
61
61
let buf = truncate ~max_len:8 buf in
62
-
(try
63
-
ignore (Tls.Reader.parse_version buf);
64
-
ignore (Tls.Reader.parse_any_version buf)
65
-
with _ -> ());
62
+
(match Tls.Reader.parse_version buf with Ok _ | Error _ -> ());
63
+
(match Tls.Reader.parse_any_version buf with Ok _ | Error _ -> ());
66
64
()
67
65
68
66
(** Certificate parsing - must handle malformed certificates. CVE-2015-0204
69
67
(FREAK) involved certificate handling. *)
70
68
let test_certificate_parse buf =
71
69
let buf = truncate ~max_len:8192 buf in
72
-
(try ignore (Tls.Reader.parse_certificates buf) with _ -> ());
70
+
(match Tls.Reader.parse_certificates buf with Ok _ | Error _ -> ());
73
71
()
74
72
75
73
(** Certificate request parsing (TLS 1.0/1.1). *)
76
74
let test_certificate_request_parse buf =
77
75
let buf = truncate ~max_len:4096 buf in
78
-
(try ignore (Tls.Reader.parse_certificate_request buf) with _ -> ());
76
+
(match Tls.Reader.parse_certificate_request buf with Ok _ | Error _ -> ());
79
77
()
80
78
81
79
(** Certificate request parsing (TLS 1.2). *)
82
80
let test_certificate_request_1_2_parse buf =
83
81
let buf = truncate ~max_len:4096 buf in
84
-
(try ignore (Tls.Reader.parse_certificate_request_1_2 buf) with _ -> ());
82
+
(match Tls.Reader.parse_certificate_request_1_2 buf with
83
+
| Ok _ | Error _ -> ());
85
84
()
86
85
87
86
(** Certificate request parsing (TLS 1.3). *)
88
87
let test_certificate_request_1_3_parse buf =
89
88
let buf = truncate ~max_len:4096 buf in
90
-
(try ignore (Tls.Reader.parse_certificate_request_1_3 buf) with _ -> ());
89
+
(match Tls.Reader.parse_certificate_request_1_3 buf with
90
+
| Ok _ | Error _ -> ());
91
91
()
92
92
93
93
(** DH parameters parsing. *)
94
94
let test_dh_parameters_parse buf =
95
95
let buf = truncate ~max_len:2048 buf in
96
-
(try ignore (Tls.Reader.parse_dh_parameters buf) with _ -> ());
96
+
(match Tls.Reader.parse_dh_parameters buf with Ok _ | Error _ -> ());
97
97
()
98
98
99
99
(** EC parameters parsing. *)
100
100
let test_ec_parameters_parse buf =
101
101
let buf = truncate ~max_len:1024 buf in
102
-
(try ignore (Tls.Reader.parse_ec_parameters buf) with _ -> ());
102
+
(match Tls.Reader.parse_ec_parameters buf with Ok _ | Error _ -> ());
103
103
()
104
104
105
105
(** Client DH key exchange parsing. *)
106
106
let test_client_dh_key_exchange buf =
107
107
let buf = truncate ~max_len:1024 buf in
108
-
(try ignore (Tls.Reader.parse_client_dh_key_exchange buf) with _ -> ());
108
+
(match Tls.Reader.parse_client_dh_key_exchange buf with
109
+
| Ok _ | Error _ -> ());
109
110
()
110
111
111
112
(** Client EC key exchange parsing. *)
112
113
let test_client_ec_key_exchange buf =
113
114
let buf = truncate ~max_len:256 buf in
114
-
(try ignore (Tls.Reader.parse_client_ec_key_exchange buf) with _ -> ());
115
+
(match Tls.Reader.parse_client_ec_key_exchange buf with
116
+
| Ok _ | Error _ -> ());
115
117
()
116
118
117
119
(** Digitally signed parsing (TLS < 1.2). *)
118
120
let test_digitally_signed buf =
119
121
let buf = truncate ~max_len:1024 buf in
120
-
(try ignore (Tls.Reader.parse_digitally_signed buf) with _ -> ());
122
+
(match Tls.Reader.parse_digitally_signed buf with Ok _ | Error _ -> ());
121
123
()
122
124
123
125
(** Digitally signed parsing (TLS 1.2). *)
124
126
let test_digitally_signed_1_2 buf =
125
127
let buf = truncate ~max_len:1024 buf in
126
-
(try ignore (Tls.Reader.parse_digitally_signed_1_2 buf) with _ -> ());
128
+
(match Tls.Reader.parse_digitally_signed_1_2 buf with Ok _ | Error _ -> ());
127
129
()
128
130
129
131
(** Certificates TLS 1.3 parsing. *)
130
132
let test_certificates_1_3 buf =
131
133
let buf = truncate ~max_len:8192 buf in
132
-
(try ignore (Tls.Reader.parse_certificates_1_3 buf) with _ -> ());
134
+
(match Tls.Reader.parse_certificates_1_3 buf with Ok _ | Error _ -> ());
133
135
()
134
136
135
137
(** Test record with specific content types. CVE references often involve
···
146
148
String.make 1 content_type ^ version ^ String.make 1 len_hi
147
149
^ String.make 1 len_lo ^ buf
148
150
in
149
-
(try ignore (Tls.Reader.parse_record record) with _ -> ());
151
+
(match Tls.Reader.parse_record record with Ok _ | Error _ -> ());
150
152
()
151
153
152
154
(** Test record overflow detection. CVE-2014-0160 (Heartbleed) exploited missing
···
174
176
end;
175
177
()
176
178
177
-
let () =
178
-
add_test ~name:"tls: record parse" [ bytes ] test_record_parse;
179
-
add_test ~name:"tls: handshake parse" [ bytes ] test_handshake_parse;
180
-
add_test ~name:"tls: handshake frame" [ bytes ] test_handshake_frame;
181
-
add_test ~name:"tls: alert parse" [ bytes ] test_alert_parse;
182
-
add_test ~name:"tls: change cipher spec" [ bytes ] test_change_cipher_spec;
183
-
add_test ~name:"tls: version parse" [ bytes ] test_version_parse;
184
-
add_test ~name:"tls: certificate parse" [ bytes ] test_certificate_parse;
185
-
add_test ~name:"tls: certificate request" [ bytes ]
186
-
test_certificate_request_parse;
187
-
add_test ~name:"tls: certificate request 1.2" [ bytes ]
188
-
test_certificate_request_1_2_parse;
189
-
add_test ~name:"tls: certificate request 1.3" [ bytes ]
190
-
test_certificate_request_1_3_parse;
191
-
add_test ~name:"tls: DH parameters" [ bytes ] test_dh_parameters_parse;
192
-
add_test ~name:"tls: EC parameters" [ bytes ] test_ec_parameters_parse;
193
-
add_test ~name:"tls: client DH key exchange" [ bytes ]
194
-
test_client_dh_key_exchange;
195
-
add_test ~name:"tls: client EC key exchange" [ bytes ]
196
-
test_client_ec_key_exchange;
197
-
add_test ~name:"tls: digitally signed" [ bytes ] test_digitally_signed;
198
-
add_test ~name:"tls: digitally signed 1.2" [ bytes ] test_digitally_signed_1_2;
199
-
add_test ~name:"tls: certificates 1.3" [ bytes ] test_certificates_1_3;
200
-
add_test ~name:"tls: record content types" [ int; bytes ]
201
-
test_record_content_types;
202
-
add_test ~name:"tls: record overflow" [ int; bytes ] test_record_overflow
179
+
let suite =
180
+
( "tls",
181
+
[
182
+
test_case "record parse" [ bytes ] test_record_parse;
183
+
test_case "handshake parse" [ bytes ] test_handshake_parse;
184
+
test_case "handshake frame" [ bytes ] test_handshake_frame;
185
+
test_case "alert parse" [ bytes ] test_alert_parse;
186
+
test_case "change cipher spec" [ bytes ] test_change_cipher_spec;
187
+
test_case "version parse" [ bytes ] test_version_parse;
188
+
test_case "certificate parse" [ bytes ] test_certificate_parse;
189
+
test_case "certificate request" [ bytes ] test_certificate_request_parse;
190
+
test_case "certificate request 1.2" [ bytes ]
191
+
test_certificate_request_1_2_parse;
192
+
test_case "certificate request 1.3" [ bytes ]
193
+
test_certificate_request_1_3_parse;
194
+
test_case "DH parameters" [ bytes ] test_dh_parameters_parse;
195
+
test_case "EC parameters" [ bytes ] test_ec_parameters_parse;
196
+
test_case "client DH key exchange" [ bytes ] test_client_dh_key_exchange;
197
+
test_case "client EC key exchange" [ bytes ] test_client_ec_key_exchange;
198
+
test_case "digitally signed" [ bytes ] test_digitally_signed;
199
+
test_case "digitally signed 1.2" [ bytes ] test_digitally_signed_1_2;
200
+
test_case "certificates 1.3" [ bytes ] test_certificates_1_3;
201
+
test_case "record content types" [ int; bytes ] test_record_content_types;
202
+
test_case "record overflow" [ int; bytes ] test_record_overflow;
203
+
] )
204
+
205
+
let () = run "tls" [ suite ]