HTTP types: headers, status codes, methods, bodies, MIME types
Add CVE-inspired hostile-input tests across 10 packages
160 new tests exercising security-critical code paths identified by
mapping known CVEs from C/reference implementations to our OCaml code:
- ocaml-sqlite (9): cyclic pages, oversized varints, record overflow,
wrong page kind, truncated WAL, out-of-bounds root, garbage files
- ocaml-cbort (12): deep nesting (CVE-2025-24302), indefinite-length
DoS, integer overflow in lengths, truncated input, invalid types
- ocaml-tar (10): path traversal (CVE-2021-32803), symlink escape
(CVE-2025-45582), oversized octal, truncated headers, checksum
- ocaml-http (14): CRLF header injection (CWE-113), null bytes,
Content-Length overflow, empty/duplicate headers
Also hardens validate_header_name_str to reject null bytes/empty names
- ocaml-jsonwt (21): "none" algorithm bypass (CVE-2015-9235) case
variations, algorithm confusion (CVE-2016-10555), malformed headers,
empty segments, extra dots, large payloads
- ocaml-cose (8): algorithm substitution, missing algorithm header,
malformed CBOR, wrong types, label overlap (RFC 9052)
- ocaml-git (18): tree path traversal, null bytes, symlink mode,
malformed tree data, pack delta attacks, pack format validation
- ocaml-tomlt (25): duplicate keys, integer overflow, malformed dates
(invalid month/day/hour/minute), deep nesting, long strings
- ocaml-squashfs (20): symlink traversal edge cases, fragment table
bounds, inode self-reference, compression bomb limits, bad superblock
- ocaml-cpio (23): symlink target validation, null bytes in filenames,
oversized filesize, truncated archives, invalid magic numbers
+159
-2
+8
-2
lib/headers.ml
+8
-2
lib/headers.ml
···
70
70
name;
71
71
reason =
72
72
"Header name contains CR/LF characters (potential HTTP smuggling)";
73
-
})
73
+
});
74
+
if String.contains name '\000' then
75
+
raise (Invalid_header { name; reason = "Header name contains null byte" });
76
+
if String.length name = 0 then
77
+
raise (Invalid_header { name; reason = "Header name is empty" })
74
78
75
79
let validate_header_value name value =
76
80
if String.contains value '\r' || String.contains value '\n' then
···
80
84
name;
81
85
reason =
82
86
"Header value contains CR/LF characters (potential HTTP smuggling)";
83
-
})
87
+
});
88
+
if String.contains value '\000' then
89
+
raise (Invalid_header { name; reason = "Header value contains null byte" })
84
90
85
91
(** {1 Core Operations with Typed Header Names} *)
86
92
+1
test/test.ml
+1
test/test.ml
+146
test/test_hostile.ml
+146
test/test_hostile.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Hostile-input security tests for HTTP headers (CWE-113, CWE-190). *)
7
+
8
+
module Headers = Http.Headers
9
+
10
+
(** Helper: assert that [f ()] raises [Headers.Invalid_header]. *)
11
+
let expect_invalid_header msg f =
12
+
match f () with
13
+
| _ -> Alcotest.fail (msg ^ ": expected Invalid_header, got success")
14
+
| exception Headers.Invalid_header _ -> ()
15
+
| exception exn ->
16
+
Alcotest.fail
17
+
(msg ^ ": expected Invalid_header, got " ^ Printexc.to_string exn)
18
+
19
+
(** {1 CRLF Injection in Header Name (CWE-113)} *)
20
+
21
+
let test_crlf_in_header_name_cr () =
22
+
expect_invalid_header "CR in header name" (fun () ->
23
+
Headers.of_list [ ("X-Bad\rName", "value") ])
24
+
25
+
let test_crlf_in_header_name_lf () =
26
+
expect_invalid_header "LF in header name" (fun () ->
27
+
Headers.of_list [ ("X-Bad\nName", "value") ])
28
+
29
+
let test_crlf_in_header_name_crlf () =
30
+
expect_invalid_header "CRLF in header name" (fun () ->
31
+
Headers.of_list [ ("X-Bad\r\nName", "value") ])
32
+
33
+
(** {1 CRLF Injection in Header Value (CWE-113)} *)
34
+
35
+
let test_crlf_in_header_value_cr () =
36
+
expect_invalid_header "CR in header value" (fun () ->
37
+
Headers.of_list [ ("X-Header", "val\rue") ])
38
+
39
+
let test_crlf_in_header_value_lf () =
40
+
expect_invalid_header "LF in header value" (fun () ->
41
+
Headers.of_list [ ("X-Header", "val\nue") ])
42
+
43
+
let test_crlf_in_header_value_crlf () =
44
+
expect_invalid_header "CRLF in header value" (fun () ->
45
+
Headers.of_list [ ("X-Header", "val\r\nue") ])
46
+
47
+
let test_crlf_smuggling_injection () =
48
+
(* Attempt to inject a second header via CRLF in value *)
49
+
expect_invalid_header "header smuggling via CRLF injection" (fun () ->
50
+
Headers.of_list [ ("X-Header", "legit\r\nX-Injected: evil") ])
51
+
52
+
(** {1 Null Byte in Header Name/Value} *)
53
+
54
+
let test_null_byte_in_header_name () =
55
+
expect_invalid_header "null byte in header name" (fun () ->
56
+
Headers.of_list [ ("X-Bad\x00Name", "value") ])
57
+
58
+
let test_null_byte_in_header_value () =
59
+
expect_invalid_header "null byte in header value" (fun () ->
60
+
Headers.of_list [ ("X-Header", "val\x00ue") ])
61
+
62
+
(** {1 Oversized Content-Length (CWE-190)} *)
63
+
64
+
let test_oversized_content_length () =
65
+
(* Int64.of_string should raise Failure for values exceeding 64-bit range.
66
+
The Response.content_length wrapper catches this and returns None.
67
+
Here we test the underlying parsing does not crash. *)
68
+
let huge = "99999999999999999999" in
69
+
let result = try Some (Int64.of_string huge) with Failure _ -> None in
70
+
Alcotest.(check (option int64))
71
+
"oversized content-length returns None" None result
72
+
73
+
(** {1 Negative Content-Length} *)
74
+
75
+
let test_negative_content_length () =
76
+
(* A negative Content-Length is syntactically valid for Int64 but
77
+
semantically invalid. Verify it parses as -1 so callers can reject. *)
78
+
let neg = "-1" in
79
+
let result = try Some (Int64.of_string neg) with Failure _ -> None in
80
+
Alcotest.(check (option int64))
81
+
"negative content-length parses as -1" (Some (-1L)) result
82
+
83
+
(** {1 Duplicate Content-Length Headers with Different Values} *)
84
+
85
+
let test_duplicate_content_length () =
86
+
(* Adding two Content-Length values should result in both being present.
87
+
Callers must detect this ambiguity to prevent request smuggling. *)
88
+
let h =
89
+
Headers.empty
90
+
|> Headers.add `Content_length "10"
91
+
|> Headers.add `Content_length "20"
92
+
in
93
+
let values = Headers.all `Content_length h in
94
+
Alcotest.(check int)
95
+
"duplicate content-length yields two values" 2 (List.length values);
96
+
Alcotest.(check (list string)) "both values present" [ "10"; "20" ] values
97
+
98
+
(** {1 Empty Header Name} *)
99
+
100
+
let test_empty_header_name () =
101
+
expect_invalid_header "empty header name" (fun () ->
102
+
Headers.of_list [ ("", "value") ])
103
+
104
+
(** {1 Header Value with Only Whitespace} *)
105
+
106
+
let test_whitespace_only_header_value () =
107
+
(* Whitespace-only values are syntactically valid per RFC 9110 but
108
+
should still be storable without crash. *)
109
+
let h = Headers.of_list [ ("X-Header", " ") ] in
110
+
let v = Headers.find (`Other "X-Header") h in
111
+
Alcotest.(check (option string))
112
+
"whitespace-only value preserved" (Some " ") v
113
+
114
+
(** {1 Test Suite} *)
115
+
116
+
let suite =
117
+
( "hostile-input",
118
+
[
119
+
Alcotest.test_case "CRLF: CR in header name" `Quick
120
+
test_crlf_in_header_name_cr;
121
+
Alcotest.test_case "CRLF: LF in header name" `Quick
122
+
test_crlf_in_header_name_lf;
123
+
Alcotest.test_case "CRLF: CRLF in header name" `Quick
124
+
test_crlf_in_header_name_crlf;
125
+
Alcotest.test_case "CRLF: CR in header value" `Quick
126
+
test_crlf_in_header_value_cr;
127
+
Alcotest.test_case "CRLF: LF in header value" `Quick
128
+
test_crlf_in_header_value_lf;
129
+
Alcotest.test_case "CRLF: CRLF in header value" `Quick
130
+
test_crlf_in_header_value_crlf;
131
+
Alcotest.test_case "CRLF: smuggling injection" `Quick
132
+
test_crlf_smuggling_injection;
133
+
Alcotest.test_case "null byte in header name" `Quick
134
+
test_null_byte_in_header_name;
135
+
Alcotest.test_case "null byte in header value" `Quick
136
+
test_null_byte_in_header_value;
137
+
Alcotest.test_case "oversized content-length" `Quick
138
+
test_oversized_content_length;
139
+
Alcotest.test_case "negative content-length" `Quick
140
+
test_negative_content_length;
141
+
Alcotest.test_case "duplicate content-length" `Quick
142
+
test_duplicate_content_length;
143
+
Alcotest.test_case "empty header name" `Quick test_empty_header_name;
144
+
Alcotest.test_case "whitespace-only header value" `Quick
145
+
test_whitespace_only_header_value;
146
+
] )