FastCGI implementation in OCaml
anil.recoil.org
1
2type version = int
3
4type record =
5 | Begin_request
6 | Abort_request
7 | End_request
8 | Params
9 | Stdin
10 | Stdout
11 | Stderr
12 | Data
13 | Get_values
14 | Get_values_result
15 | Unknown_type
16
17let record_to_int = function
18 | Begin_request -> 1
19 | Abort_request -> 2
20 | End_request -> 3
21 | Params -> 4
22 | Stdin -> 5
23 | Stdout -> 6
24 | Stderr -> 7
25 | Data -> 8
26 | Get_values -> 9
27 | Get_values_result -> 10
28 | Unknown_type -> 11
29
30let record_of_int = function
31 | 1 -> Begin_request
32 | 2 -> Abort_request
33 | 3 -> End_request
34 | 4 -> Params
35 | 5 -> Stdin
36 | 6 -> Stdout
37 | 7 -> Stderr
38 | 8 -> Data
39 | 9 -> Get_values
40 | 10 -> Get_values_result
41 | 11 -> Unknown_type
42 | n -> invalid_arg (Printf.sprintf "Unknown FastCGI record type: %d" n)
43
44let pp_record ppf = function
45 | Begin_request -> Format.pp_print_string ppf "Begin_request"
46 | Abort_request -> Format.pp_print_string ppf "Abort_request"
47 | End_request -> Format.pp_print_string ppf "End_request"
48 | Params -> Format.pp_print_string ppf "Params"
49 | Stdin -> Format.pp_print_string ppf "Stdin"
50 | Stdout -> Format.pp_print_string ppf "Stdout"
51 | Stderr -> Format.pp_print_string ppf "Stderr"
52 | Data -> Format.pp_print_string ppf "Data"
53 | Get_values -> Format.pp_print_string ppf "Get_values"
54 | Get_values_result -> Format.pp_print_string ppf "Get_values_result"
55 | Unknown_type -> Format.pp_print_string ppf "Unknown_type"
56
57type request_id = int
58
59type t = {
60 version : version;
61 record_type : record;
62 request_id : request_id;
63 content : string;
64}
65
66let pp ?(max_content_len=100) ppf record =
67 let truncated_content =
68 let content = record.content in
69 let len = String.length content in
70 if len <= max_content_len then content
71 else String.sub content 0 max_content_len ^ "..." ^ Printf.sprintf " (%d more bytes)" (len - max_content_len)
72 in
73 Format.fprintf ppf
74 "@[<2>{ version = %d;@ record_type = %a;@ request_id = %d;@ content = %S }@]"
75 record.version
76 pp_record record.record_type
77 record.request_id
78 truncated_content
79
80(* FastCGI constants *)
81let fcgi_version_1 = 1
82let fcgi_header_len = 8
83
84let read buf_read =
85 (* Read the 8-byte header *)
86 let header = Eio.Buf_read.take fcgi_header_len buf_read in
87
88 (* Parse header fields *)
89 let version = Char.code header.[0] in
90 let record_type_int = Char.code header.[1] in
91 let request_id = (Char.code header.[2] lsl 8) lor (Char.code header.[3]) in
92 let content_length = (Char.code header.[4] lsl 8) lor (Char.code header.[5]) in
93 let padding_length = Char.code header.[6] in
94 let _reserved = Char.code header.[7] in
95
96 (* Validate version *)
97 if version <> fcgi_version_1 then
98 invalid_arg (Printf.sprintf "Unsupported FastCGI version: %d" version);
99
100 (* Convert record type *)
101 let record_type = record_of_int record_type_int in
102
103 (* Read content *)
104 let content =
105 if content_length = 0 then
106 ""
107 else
108 Eio.Buf_read.take content_length buf_read
109 in
110
111 (* Skip padding *)
112 if padding_length > 0 then
113 ignore (Eio.Buf_read.take padding_length buf_read);
114
115 { version; record_type; request_id; content }
116
117let write buf_write record =
118 let content_length = String.length record.content in
119
120 (* Calculate padding for 8-byte alignment *)
121 let padding_length = (8 - (content_length land 7)) land 7 in
122
123 (* Create and write header *)
124 let header = Bytes.create fcgi_header_len in
125 Bytes.set_uint8 header 0 record.version;
126 Bytes.set_uint8 header 1 (record_to_int record.record_type);
127 Bytes.set_uint16_be header 2 record.request_id;
128 Bytes.set_uint16_be header 4 content_length;
129 Bytes.set_uint8 header 6 padding_length;
130 Bytes.set_uint8 header 7 0; (* reserved *)
131
132 Eio.Buf_write.string buf_write (Bytes.to_string header);
133
134 (* Write content *)
135 if content_length > 0 then
136 Eio.Buf_write.string buf_write record.content;
137
138 (* Write padding *)
139 if padding_length > 0 then
140 Eio.Buf_write.string buf_write (String.make padding_length '\000')
141
142let create ~version ~record ~request_id ~content =
143 { version; record_type = record; request_id; content }
144
145module KV = struct
146 type t = (string * string) list
147
148 let empty = []
149
150 let add key value kvs = (key, value) :: kvs
151
152 let remove key kvs = List.filter (fun (k, _) -> k <> key) kvs
153
154 let find key kvs =
155 try List.assoc key kvs
156 with Not_found -> raise Not_found
157
158 let find_opt key kvs =
159 try Some (List.assoc key kvs)
160 with Not_found -> None
161
162 let to_seq kvs = List.to_seq kvs
163
164 let of_seq seq = List.of_seq seq
165
166 let encode_length len =
167 if len <= 127 then
168 String.make 1 (Char.chr len)
169 else
170 let b = Bytes.create 4 in
171 Bytes.set_int32_be b 0 (Int32.logor (Int32.of_int len) 0x80000000l);
172 Bytes.to_string b
173
174 let decode_length buf pos =
175 if pos >= String.length buf then
176 failwith "Unexpected end of buffer while reading length";
177 let first_byte = Char.code buf.[pos] in
178 if first_byte land 0x80 = 0 then
179 (* Single byte length *)
180 (first_byte, pos + 1)
181 else (
182 (* Four byte length *)
183 if pos + 4 > String.length buf then
184 failwith "Unexpected end of buffer while reading 4-byte length";
185 let len =
186 ((first_byte land 0x7f) lsl 24) lor
187 ((Char.code buf.[pos + 1]) lsl 16) lor
188 ((Char.code buf.[pos + 2]) lsl 8) lor
189 (Char.code buf.[pos + 3])
190 in
191 (len, pos + 4)
192 )
193
194 let encode kvs =
195 let buf = Buffer.create 256 in
196 List.iter (fun (key, value) ->
197 let key_len = String.length key in
198 let value_len = String.length value in
199 Buffer.add_string buf (encode_length key_len);
200 Buffer.add_string buf (encode_length value_len);
201 Buffer.add_string buf key;
202 Buffer.add_string buf value
203 ) kvs;
204 Buffer.contents buf
205
206 let decode content =
207 let len = String.length content in
208 let rec loop pos acc =
209 if pos >= len then
210 List.rev acc
211 else
212 (* Read name length *)
213 let name_len, pos = decode_length content pos in
214 (* Read value length *)
215 let value_len, pos = decode_length content pos in
216
217 (* Check bounds *)
218 if pos + name_len + value_len > len then
219 failwith "Unexpected end of buffer while reading key-value data";
220
221 (* Extract name and value *)
222 let name = String.sub content pos name_len in
223 let value = String.sub content (pos + name_len) value_len in
224
225 loop (pos + name_len + value_len) ((name, value) :: acc)
226 in
227 loop 0 []
228
229 let read buf_read =
230 (* For reading from a stream, we need to determine how much data to read.
231 Since we're in a record context, we should read all available data
232 until we hit the end of the record content. *)
233 let content = Eio.Buf_read.take_all buf_read in
234 decode content
235
236 let write buf_write kvs =
237 let encoded = encode kvs in
238 Eio.Buf_write.string buf_write encoded
239
240 let pp ppf kvs =
241 Format.fprintf ppf "@[<2>[@[";
242 let first = ref true in
243 List.iter (fun (key, value) ->
244 if not !first then Format.fprintf ppf ";@ ";
245 first := false;
246 Format.fprintf ppf "(%S, %S)" key value
247 ) kvs;
248 Format.fprintf ppf "@]]@]"
249end