gazagnaire.org
forked from
anil.recoil.org/ocaml-requests
A batteries included HTTP/1.1 client in OCaml
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6(** Fuzz tests for the requests library (H1 and H2).
7
8 CVE references:
9 - CVE-2021-22945 (curl): Use-after-free via truncated response
10 - CVE-2019-18218 (libcurl): Heap overflow in chunked encoding
11 - CVE-2016-6581 (nghttp2): HPACK bomb via dynamic table
12 - CVE-2019-9515 (HTTP/2): Settings Flood DoS
13 - RFC 9112 Section 2.2: Bare CR smuggling prevention *)
14
15open Crowbar
16
17let truncate ?(max_len = 16384) buf =
18 if String.length buf > max_len then String.sub buf 0 max_len else buf
19
20(* ── HTTP/1.1 ──────────────────────────────────────────────────────────── *)
21
22let with_eio f =
23 try Eio_main.run f
24 with Eio.Io _ | End_of_file | Eio.Buf_read.Buffer_limit_exceeded -> ()
25
26let test_response_parse buf =
27 let buf = truncate buf in
28 with_eio @@ fun _env ->
29 let flow = Eio.Flow.string_source buf in
30 let limits = Response_limits.default in
31 let reader = Http_read.of_flow ~max_size:65536 flow in
32 try ignore (Http_read.response ~limits reader)
33 with Eio.Io _ | End_of_file | Eio.Buf_read.Buffer_limit_exceeded -> ()
34
35let test_chunked_parse buf =
36 let buf = truncate buf in
37 let response =
38 "HTTP/1.1 200 OK\r\nTransfer-Encoding: chunked\r\n\r\n" ^ buf
39 in
40 with_eio @@ fun _env ->
41 let flow = Eio.Flow.string_source response in
42 let limits = Response_limits.default in
43 let reader = Http_read.of_flow ~max_size:65536 flow in
44 try ignore (Http_read.response ~limits reader)
45 with Eio.Io _ | End_of_file | Eio.Buf_read.Buffer_limit_exceeded -> ()
46
47let test_header_limits buf =
48 let buf = truncate ~max_len:4096 buf in
49 let response = "HTTP/1.1 200 OK\r\n" ^ buf ^ "\r\n\r\n" in
50 with_eio @@ fun _env ->
51 let flow = Eio.Flow.string_source response in
52 let limits = Response_limits.default in
53 let reader = Http_read.of_flow ~max_size:65536 flow in
54 try ignore (Http_read.response ~limits reader)
55 with Eio.Io _ | End_of_file | Eio.Buf_read.Buffer_limit_exceeded -> ()
56
57let test_bare_cr buf =
58 let buf = truncate ~max_len:1024 buf in
59 let with_bare_cr = String.map (fun c -> if c = '\n' then '\r' else c) buf in
60 let response = "HTTP/1.1 200 OK\r\n" ^ with_bare_cr ^ "\r\n\r\n" in
61 with_eio @@ fun _env ->
62 let flow = Eio.Flow.string_source response in
63 let limits = Response_limits.default in
64 let reader = Http_read.of_flow ~max_size:65536 flow in
65 try ignore (Http_read.response ~limits reader)
66 with Eio.Io _ | End_of_file | Eio.Buf_read.Buffer_limit_exceeded -> ()
67
68let test_content_length_mismatch claimed_len buf =
69 let buf = truncate ~max_len:1024 buf in
70 let claimed = abs claimed_len mod 10000 in
71 let response =
72 Fmt.str "HTTP/1.1 200 OK\r\nContent-Length: %d\r\n\r\n%s" claimed buf
73 in
74 with_eio @@ fun _env ->
75 let flow = Eio.Flow.string_source response in
76 let limits = Response_limits.default in
77 let reader = Http_read.of_flow ~max_size:65536 flow in
78 try ignore (Http_read.response ~limits reader)
79 with Eio.Io _ | End_of_file | Eio.Buf_read.Buffer_limit_exceeded -> ()
80
81let test_http_version buf =
82 let buf = truncate ~max_len:32 buf in
83 let response = buf ^ " 200 OK\r\n\r\n" in
84 with_eio @@ fun _env ->
85 let flow = Eio.Flow.string_source response in
86 let limits = Response_limits.default in
87 let reader = Http_read.of_flow ~max_size:65536 flow in
88 try ignore (Http_read.response ~limits reader)
89 with Eio.Io _ | End_of_file | Eio.Buf_read.Buffer_limit_exceeded -> ()
90
91let test_status_code buf =
92 let buf = truncate ~max_len:16 buf in
93 let response = "HTTP/1.1 " ^ buf ^ " OK\r\n\r\n" in
94 with_eio @@ fun _env ->
95 let flow = Eio.Flow.string_source response in
96 let limits = Response_limits.default in
97 let reader = Http_read.of_flow ~max_size:65536 flow in
98 try ignore (Http_read.response ~limits reader)
99 with Eio.Io _ | End_of_file | Eio.Buf_read.Buffer_limit_exceeded -> ()
100
101let test_transfer_encoding buf =
102 let buf = truncate ~max_len:256 buf in
103 let te_header = Http_read.parse_transfer_encoding (Some buf) in
104 let _ = Http_read.validate_transfer_encoding te_header in
105 ()
106
107(* ── HTTP/2 ────────────────────────────────────────────────────────────── *)
108
109let test_frame_header_parse buf =
110 let buf = truncate ~max_len:9 buf in
111 if String.length buf >= 9 then begin
112 let cs = Cstruct.of_string buf in
113 match H2_frame.parse_frame_header cs with Ok _ -> () | Error _ -> ()
114 end;
115 ()
116
117let test_frame_parse buf =
118 let buf = truncate buf in
119 let cs = Cstruct.of_string buf in
120 let max_frame_size = H2_frame.default_max_frame_size in
121 match H2_frame.parse_frame cs ~max_frame_size with
122 | Ok _ -> ()
123 | Error _ -> ()
124
125let test_hpack_decode buf =
126 let buf = truncate ~max_len:8192 buf in
127 let decoder = H2_hpack.Decoder.create 4096 in
128 let cs = Cstruct.of_string buf in
129 match H2_hpack.Decoder.decode decoder cs with Ok _ -> () | Error _ -> ()
130
131let test_hpack_huffman buf =
132 let buf = truncate ~max_len:4096 buf in
133 match H2_hpack.Huffman.decode buf with Ok _ -> () | Error _ -> ()
134
135let test_hpack_roundtrip name_buf value_buf =
136 let name = truncate ~max_len:64 name_buf in
137 let value = truncate ~max_len:256 value_buf in
138 let is_valid_name_char c =
139 (c >= 'a' && c <= 'z') || (c >= '0' && c <= '9') || c = '-'
140 in
141 let is_valid_value_char c = c >= ' ' && c <= '~' in
142 let name = String.lowercase_ascii name in
143 let name =
144 String.to_seq name |> Seq.filter is_valid_name_char |> String.of_seq
145 in
146 let value =
147 String.to_seq value |> Seq.filter is_valid_value_char |> String.of_seq
148 in
149 if String.length name > 0 then begin
150 let headers = [ { H2_hpack.name; value; sensitive = false } ] in
151 let encoder = H2_hpack.Encoder.create 4096 in
152 let buf = Cstruct.create 4096 in
153 let len = H2_hpack.Encoder.encode_headers encoder buf headers in
154 let encoded = Cstruct.sub buf 0 len in
155 let decoder = H2_hpack.Decoder.create 4096 in
156 match H2_hpack.Decoder.decode decoder encoded with
157 | Error _ -> ()
158 | Ok decoded -> (
159 match decoded with
160 | [ h ] ->
161 if h.name <> name || h.value <> value then
162 fail "header mismatch after roundtrip"
163 | _ -> fail "wrong number of headers after roundtrip")
164 end;
165 ()
166
167let test_error_code n =
168 let code = Int32.of_int n in
169 let _ = H2_frame.error_code_of_int32 code in
170 ()
171
172let test_frame_type n =
173 let ft = H2_frame.frame_type_of_int (n mod 256) in
174 let n' = H2_frame.frame_type_to_int ft in
175 match ft with
176 | H2_frame.Unknown x -> if x <> n mod 256 then fail "unknown type mismatch"
177 | _ -> if n' <> n mod 256 then fail "known type mismatch"
178
179let test_setting_parse id value =
180 let id = id mod 256 in
181 let value = Int32.of_int value in
182 let setting = H2_frame.setting_of_pair id value in
183 let _ = H2_frame.setting_to_pair setting in
184 ()
185
186let test_stream_id n =
187 let id = Int32.of_int (abs n) in
188 let is_client = H2_frame.stream_id_is_client_initiated id in
189 let is_server = H2_frame.stream_id_is_server_initiated id in
190 if is_client && is_server then fail "stream id is both client and server"
191
192(* ── Suite ─────────────────────────────────────────────────────────────── *)
193
194let suite =
195 ( "requests",
196 [
197 (* H1 *)
198 test_case "h1 response parse" [ bytes ] test_response_parse;
199 test_case "h1 chunked body" [ bytes ] test_chunked_parse;
200 test_case "h1 header limits" [ bytes ] test_header_limits;
201 test_case "h1 bare CR detection" [ bytes ] test_bare_cr;
202 test_case "h1 content-length mismatch" [ int; bytes ]
203 test_content_length_mismatch;
204 test_case "h1 http version" [ bytes ] test_http_version;
205 test_case "h1 status code" [ bytes ] test_status_code;
206 test_case "h1 transfer-encoding" [ bytes ] test_transfer_encoding;
207 (* H2 *)
208 test_case "h2 frame header" [ bytes ] test_frame_header_parse;
209 test_case "h2 frame parse" [ bytes ] test_frame_parse;
210 test_case "h2 hpack decode" [ bytes ] test_hpack_decode;
211 test_case "h2 hpack huffman" [ bytes ] test_hpack_huffman;
212 test_case "h2 hpack roundtrip" [ bytes; bytes ] test_hpack_roundtrip;
213 test_case "h2 error code" [ int ] test_error_code;
214 test_case "h2 frame type" [ int ] test_frame_type;
215 test_case "h2 setting parse" [ int; int ] test_setting_parse;
216 test_case "h2 stream id" [ int ] test_stream_id;
217 ] )