···
3
+
(** {1 Request Roles} *)
10
+
let 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"
15
+
let 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"
21
+
let content = record.content in
22
+
let role_int = (Char.code content.[0] lsl 8) lor (Char.code content.[1]) in
25
+
| 2 -> Ok Authorizer
27
+
| n -> Error (Printf.sprintf "Unknown FastCGI role: %d" n)
29
+
(** {1 Request Context} *)
32
+
request_id : request_id;
36
+
stdin_data : string;
37
+
data_stream : string option;
40
+
let pp ppf request =
41
+
let data_str = match request.data_stream with
43
+
| Some d -> Printf.sprintf "Some(%d bytes)" (String.length d)
46
+
"@[<2>{ request_id = %d;@ role = %a;@ keep_conn = %b;@ params = %a;@ stdin = %d bytes;@ data = %s }@]"
48
+
pp_role request.role
50
+
(KV.pp) request.params
51
+
(String.length request.stdin_data)
55
+
match role_of_begin_request record with
58
+
if String.length record.content <> 8 then
59
+
Error "Invalid BEGIN_REQUEST content length"
61
+
let flags_int = Char.code record.content.[2] in
62
+
let keep_conn = (flags_int land 1) <> 0 in
64
+
request_id = record.request_id;
69
+
data_stream = if role = Filter then Some "" else None;
73
+
(** {1 Stream Processing} *)
75
+
(** Helper functions for result binding to simplify nested pattern matching *)
76
+
let ( let* ) = Result.bind
78
+
let is_stream_terminator record =
79
+
String.length record.content = 0
82
+
let read_params_from_flow ~sw:_ flow =
83
+
let buf_read = Eio.Buf_read.of_flow flow ~max_size:1000000 in
84
+
let params = ref KV.empty in
87
+
let record = Fastcgi_record.read buf_read in
88
+
if record.record_type <> Params then
89
+
Error (Printf.sprintf "Expected PARAMS record, got %s"
90
+
(Format.asprintf "%a" pp_record record.record_type))
91
+
else if is_stream_terminator record then
94
+
let record_params = KV.decode record.content in
95
+
params := KV.to_seq record_params
96
+
|> Seq.fold_left (fun acc (k, v) -> KV.add k v acc) !params;
100
+
| End_of_file -> Error "Unexpected end of stream while reading PARAMS"
101
+
| exn -> Error (Printf.sprintf "Error reading PARAMS: %s" (Printexc.to_string exn))
105
+
let read_stdin_from_flow ~sw:_ flow =
106
+
let buf_read = Eio.Buf_read.of_flow flow ~max_size:1000000 in
107
+
let data = Buffer.create 1024 in
110
+
let record = Fastcgi_record.read buf_read in
111
+
if record.record_type <> Stdin then
112
+
Error (Printf.sprintf "Expected STDIN record, got %s"
113
+
(Format.asprintf "%a" pp_record record.record_type))
114
+
else if is_stream_terminator record then
115
+
Ok (Buffer.contents data)
117
+
Buffer.add_string data record.content;
121
+
| End_of_file -> Error "Unexpected end of stream while reading STDIN"
122
+
| exn -> Error (Printf.sprintf "Error reading STDIN: %s" (Printexc.to_string exn))
126
+
(** Read DATA stream for Filter role *)
127
+
let read_data_from_flow buf_read =
128
+
let data_buf = Buffer.create 1024 in
129
+
let rec read_data () =
131
+
let record = Fastcgi_record.read buf_read in
132
+
if record.record_type <> Data then
133
+
Error "Expected DATA record"
134
+
else if is_stream_terminator record then
135
+
Ok (Buffer.contents data_buf)
137
+
Buffer.add_string data_buf record.content;
141
+
| End_of_file -> Error "Unexpected end of DATA stream"
142
+
| exn -> Error (Printf.sprintf "Error reading DATA: %s" (Printexc.to_string exn))
146
+
(** Read request streams based on role *)
147
+
let read_request_streams ~sw request flow buf_read =
148
+
match request.role with
152
+
let* stdin_data = read_stdin_from_flow ~sw flow in
153
+
Ok { request with stdin_data }
155
+
let* stdin_data = read_stdin_from_flow ~sw flow in
156
+
let request = { request with stdin_data } in
157
+
let* data = read_data_from_flow buf_read in
158
+
Ok { request with data_stream = Some data }
160
+
let read_request_from_flow ~sw flow =
161
+
let buf_read = Eio.Buf_read.of_flow flow ~max_size:1000000 in
163
+
(* Read BEGIN_REQUEST *)
164
+
let begin_record = Fastcgi_record.read buf_read in
165
+
let* request = create begin_record in
166
+
(* Read PARAMS stream *)
167
+
let* params = read_params_from_flow ~sw flow in
168
+
let request = { request with params } in
169
+
(* Read remaining streams based on role *)
170
+
read_request_streams ~sw request flow buf_read
172
+
| End_of_file -> Error "Unexpected end of stream"
173
+
| exn -> Error (Printf.sprintf "Error reading request: %s" (Printexc.to_string exn))
175
+
(** {1 Response Generation} *)
177
+
type app_status = int
178
+
type protocol_status =
184
+
let pp_protocol_status ppf = function
185
+
| Request_complete -> Format.pp_print_string ppf "Request_complete"
186
+
| Cant_mpx_conn -> Format.pp_print_string ppf "Cant_mpx_conn"
187
+
| Overloaded -> Format.pp_print_string ppf "Overloaded"
188
+
| Unknown_role -> Format.pp_print_string ppf "Unknown_role"
190
+
let protocol_status_to_int = function
191
+
| Request_complete -> 0
192
+
| Cant_mpx_conn -> 1
194
+
| Unknown_role -> 3
196
+
let stream_records_to_string records =
197
+
let buf = Buffer.create 1024 in
198
+
List.iter (fun record ->
199
+
if not (is_stream_terminator record) then
200
+
Buffer.add_string buf record.content
202
+
Buffer.contents buf
204
+
let string_to_stream_records ~request_id ~record_type content =
205
+
let max_chunk = 65535 in (* FastCGI max record content length *)
206
+
let len = String.length content in
207
+
let records = ref [] in
209
+
let rec chunk_string pos =
211
+
() (* Empty terminator will be added separately *)
213
+
let chunk_len = min max_chunk (len - pos) in
214
+
let chunk = String.sub content pos chunk_len in
215
+
let record = Fastcgi_record.create ~version:1 ~record:record_type ~request_id ~content:chunk in
216
+
records := record :: !records;
217
+
chunk_string (pos + chunk_len)
222
+
(* Add stream terminator *)
223
+
let terminator = Fastcgi_record.create ~version:1 ~record:record_type ~request_id ~content:"" in
224
+
records := terminator :: !records;
228
+
let flow_to_stream_records ~sw:_ ~request_id ~record_type flow =
229
+
(* Read entire flow content *)
230
+
let buf = Buffer.create 4096 in
231
+
Eio.Flow.copy flow (Eio.Flow.buffer_sink buf);
232
+
let content = Buffer.contents buf in
233
+
string_to_stream_records ~request_id ~record_type content
235
+
let write_stream_records records sink =
236
+
(* Create a function to serialize a single record to a string *)
237
+
let serialize_record record =
238
+
let buf = Buffer.create 512 in
239
+
let buf_sink = Eio.Flow.buffer_sink buf in
240
+
Eio.Buf_write.with_flow buf_sink (fun buf_write ->
241
+
Fastcgi_record.write buf_write record
243
+
Buffer.contents buf
246
+
(* Serialize all records and write to sink *)
247
+
List.iter (fun record ->
248
+
let serialized = serialize_record record in
249
+
Eio.Flow.copy_string serialized sink
252
+
let make_end_request ~request_id ~app_status ~protocol_status =
254
+
let buf = Bytes.create 8 in
255
+
Bytes.set_int32_be buf 0 (Int32.of_int app_status);
256
+
Bytes.set_uint8 buf 4 (protocol_status_to_int protocol_status);
257
+
Bytes.set_uint8 buf 5 0; (* reserved *)
258
+
Bytes.set_uint8 buf 6 0; (* reserved *)
259
+
Bytes.set_uint8 buf 7 0; (* reserved *)
260
+
Bytes.to_string buf
262
+
Fastcgi_record.create ~version:1 ~record:End_request ~request_id ~content
264
+
let write_response ~sw request ~stdout ~stderr sink app_status =
265
+
(* Convert stdout flow to STDOUT records *)
266
+
let stdout_records = flow_to_stream_records ~sw ~request_id:request.request_id ~record_type:Stdout stdout in
268
+
(* Convert stderr flow to STDERR records *)
269
+
let stderr_records = flow_to_stream_records ~sw ~request_id:request.request_id ~record_type:Stderr stderr in
271
+
(* Create END_REQUEST record *)
272
+
let end_record = make_end_request ~request_id:request.request_id ~app_status ~protocol_status:Request_complete in
274
+
(* Write all records *)
275
+
let all_records = stdout_records @ stderr_records @ [end_record] in
276
+
write_stream_records all_records sink
278
+
let write_error_response request sink proto_status =
279
+
let end_record = make_end_request ~request_id:request.request_id ~app_status:1 ~protocol_status:proto_status in
280
+
write_stream_records [end_record] sink
282
+
let write_abort_response request sink =
283
+
let end_record = make_end_request ~request_id:request.request_id ~app_status:0 ~protocol_status:Request_complete in
284
+
write_stream_records [end_record] sink
286
+
(** {1 High-level Request Processing} *)
288
+
type handler = t ->
289
+
stdout:Eio.Flow.sink_ty Eio.Resource.t ->
290
+
stderr:Eio.Flow.sink_ty Eio.Resource.t ->
293
+
let process_request ~sw request handler sink =
294
+
(* Create in-memory flows for stdout and stderr *)
295
+
let stdout_buf = Buffer.create 4096 in
296
+
let stderr_buf = Buffer.create 1024 in
297
+
let stdout_sink = Eio.Flow.buffer_sink stdout_buf in
298
+
let stderr_sink = Eio.Flow.buffer_sink stderr_buf in
301
+
let app_status = handler request ~stdout:stdout_sink ~stderr:stderr_sink in
303
+
(* Convert buffers to sources and write response *)
304
+
let stdout_source = Eio.Flow.string_source (Buffer.contents stdout_buf) in
305
+
let stderr_source = Eio.Flow.string_source (Buffer.contents stderr_buf) in
307
+
write_response ~sw request ~stdout:stdout_source ~stderr:stderr_source sink app_status
309
+
let process_request_with_flows ~sw request ~stdout ~stderr sink app_status =
310
+
write_response ~sw request ~stdout ~stderr sink app_status
312
+
(** {1 Connection Management} *)
314
+
let handle_connection ~sw flow handler =
315
+
let _buf_read = Eio.Buf_read.of_flow flow ~max_size:1000000 in
316
+
let _buf_write = Eio.Buf_write.create 4096 in
320
+
(* Read next request *)
321
+
match read_request_from_flow ~sw flow with
323
+
(* Log error and continue or close connection *)
324
+
Printf.eprintf "Error reading request: %s\n%!" msg
326
+
(* Process request *)
327
+
let response_buf = Buffer.create 4096 in
328
+
let response_sink = Eio.Flow.buffer_sink response_buf in
330
+
process_request ~sw request handler response_sink;
332
+
(* Write response to connection *)
333
+
let response_data = Buffer.contents response_buf in
334
+
Eio.Flow.copy (Eio.Flow.string_source response_data) flow;
336
+
(* Continue if keep_conn is true *)
337
+
if request.keep_conn then
340
+
| End_of_file -> () (* Connection closed *)
342
+
Printf.eprintf "Connection error: %s\n%!" (Printexc.to_string exn)
346
+
let serve ~sw:_ ~backlog:_ ~port:_ _handler =
347
+
(* This would typically use Eio.Net to create a listening socket *)
348
+
(* For now, we'll provide a placeholder implementation *)
349
+
failwith "serve: Implementation requires Eio.Net integration"
anil.recoil.org