anil.recoil.org
An OCaml webserver, but the allocating version (vs httpz which doesnt)
1(* buf_read.ml - Buffer type and utilities for HTTP parsing *)
2
3type status =
4 | Complete
5 | Partial
6 | Invalid_method
7 | Invalid_target
8 | Invalid_version
9 | Invalid_header
10 | Headers_too_large
11 | Malformed
12 | Content_length_overflow (* Content-Length value too large or invalid *)
13 | Ambiguous_framing (* Both Content-Length and Transfer-Encoding present *)
14 | Bare_cr_detected (* CR without LF - HTTP smuggling attempt *)
15 | Missing_host_header (* HTTP/1.1 requires Host header *)
16 | Unsupported_transfer_encoding (* Transfer-Encoding other than chunked/identity *)
17
18let status_to_string = function
19 | Complete -> "Complete"
20 | Partial -> "Partial"
21 | Invalid_method -> "Invalid_method"
22 | Invalid_target -> "Invalid_target"
23 | Invalid_version -> "Invalid_version"
24 | Invalid_header -> "Invalid_header"
25 | Headers_too_large -> "Headers_too_large"
26 | Malformed -> "Malformed"
27 | Content_length_overflow -> "Content_length_overflow"
28 | Ambiguous_framing -> "Ambiguous_framing"
29 | Bare_cr_detected -> "Bare_cr_detected"
30 | Missing_host_header -> "Missing_host_header"
31 | Unsupported_transfer_encoding -> "Unsupported_transfer_encoding"
32;;
33
34let pp_status fmt t = Stdlib.Format.fprintf fmt "%s" (status_to_string t)
35
36open Base
37
38let buffer_size = 32768
39let max_headers = 32
40
41let create () = Base_bigstring.create buffer_size
42let peek buf pos = Base_bigstring.unsafe_get buf pos
43
44let is_token_char c =
45 match c with
46 | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' -> true
47 | '!' | '#' | '$' | '%' | '&' | '\'' | '*' | '+' | '-' | '.' -> true
48 | '^' | '_' | '`' | '|' | '~' -> true
49 | _ -> false
50;;
51
52let is_space c =
53 match c with
54 | ' ' | '\t' -> true
55 | _ -> false
56;;
57
58let to_lower c =
59 match c with
60 | 'A' .. 'Z' -> Char.of_int_exn (Char.to_int c + 32)
61 | _ -> c
62;;
63
64let find_crlf buf ~pos ~len =
65 if len - pos < 2
66 then -1
67 else (
68 let p = ref pos in
69 let found = ref false in
70 while (not !found) && !p + 1 < len do
71 let search_pos = !p in
72 let search_len = len - !p in
73 let cr_pos = Base_bigstring.unsafe_find buf '\r' ~pos:search_pos ~len:search_len in
74 if cr_pos < 0 || cr_pos >= len - 1
75 then p := len
76 else if Char.equal (Base_bigstring.unsafe_get buf (cr_pos + 1)) '\n'
77 then (
78 p := cr_pos;
79 found := true)
80 else p := cr_pos + 1
81 done;
82 if !found then !p else -1)
83;;
84
85let pp fmt _t = Stdlib.Format.fprintf fmt "<buffer %d bytes>" buffer_size
86
87(* Security limits - configurable per-server *)
88type limits =
89 { max_content_length : int64 (* Default: 100MB *)
90 ; max_header_size : int (* Default: 16KB - size of all headers combined *)
91 ; max_header_count : int (* Default: 100 *)
92 ; max_chunk_size : int (* Default: 16MB *)
93 }
94
95let default_limits =
96 { max_content_length = 104857600L (* 100MB *)
97 ; max_header_size = 16384 (* 16KB *)
98 ; max_header_count = 100
99 ; max_chunk_size = 16777216 (* 16MB *)
100 }
101
102(* Detect bare CR (CR not followed by LF) - RFC 7230 Section 3.5
103 Used to prevent HTTP request smuggling attacks *)
104let has_bare_cr buf ~pos ~len =
105 let end_pos = pos + len in
106 let p = ref pos in
107 let found = ref false in
108 while (not !found) && !p < end_pos do
109 if Char.equal (peek buf !p) '\r' then (
110 if !p + 1 >= end_pos || not (Char.equal (peek buf (!p + 1)) '\n') then
111 found := true
112 else
113 p := !p + 2 (* Skip past valid CRLF *)
114 ) else
115 Int.incr p
116 done;
117 !found
118;;
119
120(* Check if a value contains CRLF injection attempt *)
121let has_crlf_injection buf ~pos ~len =
122 let end_pos = pos + len in
123 let p = ref pos in
124 let found = ref false in
125 while (not !found) && !p < end_pos do
126 match peek buf !p with
127 | '\r' | '\n' -> found := true
128 | _ -> Int.incr p
129 done;
130 !found
131;;