FastCGI implementation in OCaml
anil.recoil.org
1open Fastcgi_record
2
3(** {1 Request Roles} *)
4
5type role =
6 | Responder
7 | Authorizer
8 | Filter
9
10let pp_role ppf = function
11 | Responder -> Format.pp_print_string ppf "Responder"
12 | Authorizer -> Format.pp_print_string ppf "Authorizer"
13 | Filter -> Format.pp_print_string ppf "Filter"
14
15let role_of_begin_request record =
16 if record.record_type <> Begin_request then
17 Error "Expected BEGIN_REQUEST record"
18 else if String.length record.content <> 8 then
19 Error "Invalid BEGIN_REQUEST content length"
20 else
21 let content = record.content in
22 let role_int = (Char.code content.[0] lsl 8) lor (Char.code content.[1]) in
23 match role_int with
24 | 1 -> Ok Responder
25 | 2 -> Ok Authorizer
26 | 3 -> Ok Filter
27 | n -> Error (Printf.sprintf "Unknown FastCGI role: %d" n)
28
29(** {1 Request Context} *)
30
31type t = {
32 request_id : request_id;
33 role : role;
34 keep_conn : bool;
35 params : KV.t;
36 stdin_data : string;
37 data_stream : string option;
38}
39
40let pp ppf request =
41 let data_str = match request.data_stream with
42 | None -> "None"
43 | Some d -> Printf.sprintf "Some(%d bytes)" (String.length d)
44 in
45 Format.fprintf ppf
46 "@[<2>{ request_id = %d;@ role = %a;@ keep_conn = %b;@ params = %a;@ stdin = %d bytes;@ data = %s }@]"
47 request.request_id
48 pp_role request.role
49 request.keep_conn
50 (KV.pp) request.params
51 (String.length request.stdin_data)
52 data_str
53
54let create record =
55 match role_of_begin_request record with
56 | Error _ as e -> e
57 | Ok role ->
58 if String.length record.content <> 8 then
59 Error "Invalid BEGIN_REQUEST content length"
60 else
61 let flags_int = Char.code record.content.[2] in
62 let keep_conn = (flags_int land 1) <> 0 in
63 Ok {
64 request_id = record.request_id;
65 role;
66 keep_conn;
67 params = KV.empty;
68 stdin_data = "";
69 data_stream = if role = Filter then Some "" else None;
70 }
71
72
73(** {1 Stream Processing} *)
74
75(** Helper functions for result binding to simplify nested pattern matching *)
76let ( let* ) = Result.bind
77
78let is_stream_terminator record =
79 String.length record.content = 0
80
81
82let read_params buf_read =
83 Printf.eprintf "[DEBUG] read_params_from_flow: Starting\n%!";
84 let params = ref KV.empty in
85 let rec loop () =
86 try
87 Printf.eprintf "[DEBUG] read_params_from_flow: Reading next PARAMS record\n%!";
88 let record = Fastcgi_record.read buf_read in
89 Printf.eprintf "[DEBUG] read_params_from_flow: Got record type=%s, content_length=%d\n%!"
90 (Format.asprintf "%a" pp_record record.record_type)
91 (String.length record.content);
92 if record.record_type <> Params then
93 Error (Printf.sprintf "Expected PARAMS record, got %s"
94 (Format.asprintf "%a" pp_record record.record_type))
95 else if is_stream_terminator record then (
96 Printf.eprintf "[DEBUG] read_params_from_flow: Got stream terminator, returning %d params\n%!"
97 (Fastcgi_record.KV.cardinal !params);
98 Ok !params
99 ) else (
100 let record_params = KV.decode record.content in
101 Printf.eprintf "[DEBUG] read_params_from_flow: Decoded %d params from record\n%!"
102 (Fastcgi_record.KV.cardinal record_params);
103 params := KV.to_seq record_params
104 |> Seq.fold_left (fun acc (k, v) -> KV.add k v acc) !params;
105 loop ()
106 )
107 with
108 | End_of_file ->
109 Printf.eprintf "[DEBUG] read_params_from_flow: Hit End_of_file\n%!";
110 Error "Unexpected end of stream while reading PARAMS"
111 | exn ->
112 Printf.eprintf "[DEBUG] read_params_from_flow: Exception: %s\n%!" (Printexc.to_string exn);
113 Error (Printf.sprintf "Error reading PARAMS: %s" (Printexc.to_string exn))
114 in
115 loop ()
116
117let read_stdin buf_read =
118 Printf.eprintf "[DEBUG] read_stdin_from_flow: Starting\n%!";
119 let data = Buffer.create 1024 in
120 let rec loop () =
121 try
122 Printf.eprintf "[DEBUG] read_stdin_from_flow: Reading next STDIN record\n%!";
123 let record = Fastcgi_record.read buf_read in
124 Printf.eprintf "[DEBUG] read_stdin_from_flow: Got record type=%s, content_length=%d\n%!"
125 (Format.asprintf "%a" pp_record record.record_type)
126 (String.length record.content);
127 if record.record_type <> Stdin then
128 Error (Printf.sprintf "Expected STDIN record, got %s"
129 (Format.asprintf "%a" pp_record record.record_type))
130 else if is_stream_terminator record then (
131 Printf.eprintf "[DEBUG] read_stdin_from_flow: Got stream terminator, total stdin=%d bytes\n%!"
132 (Buffer.length data);
133 Ok (Buffer.contents data)
134 ) else (
135 Buffer.add_string data record.content;
136 Printf.eprintf "[DEBUG] read_stdin_from_flow: Added %d bytes, total now %d\n%!"
137 (String.length record.content) (Buffer.length data);
138 loop ()
139 )
140 with
141 | End_of_file ->
142 Printf.eprintf "[DEBUG] read_stdin_from_flow: Hit End_of_file\n%!";
143 Error "Unexpected end of stream while reading STDIN"
144 | exn ->
145 Printf.eprintf "[DEBUG] read_stdin_from_flow: Exception: %s\n%!" (Printexc.to_string exn);
146 Error (Printf.sprintf "Error reading STDIN: %s" (Printexc.to_string exn))
147 in
148 loop ()
149
150(** Read DATA stream for Filter role *)
151let read_data buf_read =
152 let data_buf = Buffer.create 1024 in
153 let rec read_data () =
154 try
155 let record = Fastcgi_record.read buf_read in
156 if record.record_type <> Data then
157 Error "Expected DATA record"
158 else if is_stream_terminator record then
159 Ok (Buffer.contents data_buf)
160 else (
161 Buffer.add_string data_buf record.content;
162 read_data ()
163 )
164 with
165 | End_of_file -> Error "Unexpected end of DATA stream"
166 | exn -> Error (Printf.sprintf "Error reading DATA: %s" (Printexc.to_string exn))
167 in
168 read_data ()
169
170(** Read request streams based on role *)
171let read_request_streams request buf_read =
172 Printf.eprintf "[DEBUG] read_request_streams: Processing role=%s\n%!"
173 (Format.asprintf "%a" pp_role request.role);
174 match request.role with
175 | Authorizer ->
176 Printf.eprintf "[DEBUG] read_request_streams: Authorizer role, no streams to read\n%!";
177 Ok request
178 | Responder ->
179 Printf.eprintf "[DEBUG] read_request_streams: Responder role, reading STDIN\n%!";
180 let* stdin_data = read_stdin buf_read in
181 Printf.eprintf "[DEBUG] read_request_streams: Got STDIN data, %d bytes\n%!" (String.length stdin_data);
182 Ok { request with stdin_data }
183 | Filter ->
184 Printf.eprintf "[DEBUG] read_request_streams: Filter role, reading STDIN and DATA\n%!";
185 let* stdin_data = read_stdin buf_read in
186 Printf.eprintf "[DEBUG] read_request_streams: Got STDIN data, %d bytes\n%!" (String.length stdin_data);
187 let request = { request with stdin_data } in
188 let* data = read_data buf_read in
189 Printf.eprintf "[DEBUG] read_request_streams: Got DATA stream, %d bytes\n%!" (String.length data);
190 Ok { request with data_stream = Some data }
191
192let read_request buf_read =
193 Printf.eprintf "[DEBUG] read_request: Starting\n%!";
194 try
195 (* Read BEGIN_REQUEST *)
196 Printf.eprintf "[DEBUG] read_request: Reading BEGIN_REQUEST record\n%!";
197 let begin_record = Fastcgi_record.read buf_read in
198 Printf.eprintf "[DEBUG] read_request: Got BEGIN_REQUEST record: %s\n%!"
199 (Format.asprintf "%a" (Fastcgi_record.pp ~max_content_len:50) begin_record);
200 let* request = create begin_record in
201 Printf.eprintf "[DEBUG] read_request: Created request with role=%s, id=%d\n%!"
202 (Format.asprintf "%a" pp_role request.role) request.request_id;
203 (* Read PARAMS stream *)
204 Printf.eprintf "[DEBUG] read_request: Reading PARAMS stream\n%!";
205 let* params = read_params buf_read in
206 Printf.eprintf "[DEBUG] read_request: Got %d params\n%!" (Fastcgi_record.KV.cardinal params);
207 let request = { request with params } in
208 (* Read remaining streams based on role *)
209 Printf.eprintf "[DEBUG] read_request: Reading streams for role=%s\n%!"
210 (Format.asprintf "%a" pp_role request.role);
211 let result = read_request_streams request buf_read in
212 Printf.eprintf "[DEBUG] read_request: Finished reading request\n%!";
213 result
214 with
215 | End_of_file ->
216 Printf.eprintf "[DEBUG] read_request: Hit End_of_file\n%!";
217 Error "Unexpected end of stream"
218 | exn ->
219 Printf.eprintf "[DEBUG] read_request: Exception: %s\n%!" (Printexc.to_string exn);
220 Error (Printf.sprintf "Error reading request: %s" (Printexc.to_string exn))
221
222(** {1 Response Generation} *)
223
224type app_status = int
225type protocol_status =
226 | Request_complete
227 | Cant_mpx_conn
228 | Overloaded
229 | Unknown_role
230
231let pp_protocol_status ppf = function
232 | Request_complete -> Format.pp_print_string ppf "Request_complete"
233 | Cant_mpx_conn -> Format.pp_print_string ppf "Cant_mpx_conn"
234 | Overloaded -> Format.pp_print_string ppf "Overloaded"
235 | Unknown_role -> Format.pp_print_string ppf "Unknown_role"
236
237let protocol_status_to_int = function
238 | Request_complete -> 0
239 | Cant_mpx_conn -> 1
240 | Overloaded -> 2
241 | Unknown_role -> 3
242
243let stream_records_to_string records =
244 let buf = Buffer.create 1024 in
245 List.iter (fun record ->
246 if not (is_stream_terminator record) then
247 Buffer.add_string buf record.content
248 ) records;
249 Buffer.contents buf
250
251let string_to_stream_records ~request_id ~record_type content =
252 let max_chunk = 65535 in (* FastCGI max record content length *)
253 let len = String.length content in
254 let records = ref [] in
255
256 let rec chunk_string pos =
257 if pos >= len then
258 () (* Empty terminator will be added separately *)
259 else
260 let chunk_len = min max_chunk (len - pos) in
261 let chunk = String.sub content pos chunk_len in
262 let record = Fastcgi_record.create ~version:1 ~record:record_type ~request_id ~content:chunk in
263 records := record :: !records;
264 chunk_string (pos + chunk_len)
265 in
266
267 chunk_string 0;
268
269 (* Add stream terminator *)
270 let terminator = Fastcgi_record.create ~version:1 ~record:record_type ~request_id ~content:"" in
271 records := terminator :: !records;
272
273 List.rev !records
274
275let write_stream_records buf_write request_id record_type content =
276 let max_chunk = 65535 in (* FastCGI max record content length *)
277 let len = String.length content in
278
279 let rec chunk_string pos =
280 if pos >= len then
281 () (* Empty terminator will be added separately *)
282 else
283 let chunk_len = min max_chunk (len - pos) in
284 let chunk = String.sub content pos chunk_len in
285 let record = Fastcgi_record.create ~version:1 ~record:record_type ~request_id ~content:chunk in
286 Fastcgi_record.write buf_write record;
287 chunk_string (pos + chunk_len)
288 in
289
290 chunk_string 0;
291
292 (* Add stream terminator *)
293 let terminator = Fastcgi_record.create ~version:1 ~record:record_type ~request_id ~content:"" in
294 Fastcgi_record.write buf_write terminator
295
296let write_stdout_records buf_write request_id content =
297 write_stream_records buf_write request_id Stdout content
298
299let write_stderr_records buf_write request_id content =
300 write_stream_records buf_write request_id Stderr content
301
302let write_end_request buf_write request_id app_status protocol_status =
303 let content =
304 let buf = Bytes.create 8 in
305 Bytes.set_int32_be buf 0 (Int32.of_int app_status);
306 Bytes.set_uint8 buf 4 (protocol_status_to_int protocol_status);
307 Bytes.set_uint8 buf 5 0; (* reserved *)
308 Bytes.set_uint8 buf 6 0; (* reserved *)
309 Bytes.set_uint8 buf 7 0; (* reserved *)
310 Bytes.to_string buf
311 in
312 let record = Fastcgi_record.create ~version:1 ~record:End_request ~request_id ~content in
313 Fastcgi_record.write buf_write record
314