this repo has no description
more
+141
-224
+58
-64
bin/fcgi_server.ml
+58
-64
bin/fcgi_server.ml
···
1
1
open Cmdliner
2
2
3
+
(* Handler function that processes FastCGI requests *)
4
+
let handler ~stdout ~stderr request =
5
+
Eio.traceln "Processing request: %a" Fastcgi.Request.pp request;
6
+
7
+
(* Get request parameters *)
8
+
let params = request.Fastcgi.Request.params in
9
+
let method_ = Fastcgi.Record.KV.find_opt "REQUEST_METHOD" params |> Option.value ~default:"GET" in
10
+
let uri = Fastcgi.Record.KV.find_opt "REQUEST_URI" params |> Option.value ~default:"/" in
11
+
let script_name = Fastcgi.Record.KV.find_opt "SCRIPT_NAME" params |> Option.value ~default:"" in
12
+
13
+
(* Log request info *)
14
+
Eio.traceln " Method: %s" method_;
15
+
Eio.traceln " URI: %s" uri;
16
+
Eio.traceln " Script: %s" script_name;
17
+
18
+
(* Generate simple HTTP response *)
19
+
let response_body =
20
+
Printf.sprintf
21
+
"<!DOCTYPE html>\n\
22
+
<html>\n\
23
+
<head><title>FastCGI OCaml Server</title></head>\n\
24
+
<body>\n\
25
+
<h1>FastCGI OCaml Server</h1>\n\
26
+
<p>Request processed successfully!</p>\n\
27
+
<ul>\n\
28
+
<li>Method: %s</li>\n\
29
+
<li>URI: %s</li>\n\
30
+
<li>Script: %s</li>\n\
31
+
</ul>\n\
32
+
<h2>All Parameters:</h2>\n\
33
+
<pre>%s</pre>\n\
34
+
</body>\n\
35
+
</html>\n"
36
+
method_ uri script_name
37
+
(let params_seq = Fastcgi.Record.KV.to_seq params in
38
+
let params_list = List.of_seq params_seq in
39
+
String.concat "\n" (List.map (fun (k, v) -> Printf.sprintf "%s = %s" k v) params_list))
40
+
in
41
+
42
+
(* Write HTTP response using FastCGI STDOUT records *)
43
+
let response_headers =
44
+
Printf.sprintf
45
+
"Status: 200 OK\r\n\
46
+
Content-Type: text/html; charset=utf-8\r\n\
47
+
Content-Length: %d\r\n\
48
+
\r\n"
49
+
(String.length response_body)
50
+
in
51
+
stdout response_headers;
52
+
stderr "stderr stuff";
53
+
stdout response_body
54
+
3
55
let run port =
4
56
Eio_main.run @@ fun env ->
5
57
Eio.Switch.run @@ fun sw ->
···
7
59
let addr = `Tcp (Eio.Net.Ipaddr.V4.loopback, port) in
8
60
let server_socket = Eio.Net.listen net ~backlog:10 ~reuse_addr:true ~sw addr in
9
61
Eio.traceln "FastCGI server listening on port %d" port;
10
-
11
-
(* Handler function that processes FastCGI requests *)
12
-
let handler ~sw:_ request output =
13
-
Eio.traceln "Processing request: %a" Fastcgi.Request.pp request;
14
-
15
-
(* Get request parameters *)
16
-
let params = request.Fastcgi.Request.params in
17
-
let method_ = Fastcgi.Record.KV.find_opt "REQUEST_METHOD" params |> Option.value ~default:"GET" in
18
-
let uri = Fastcgi.Record.KV.find_opt "REQUEST_URI" params |> Option.value ~default:"/" in
19
-
let script_name = Fastcgi.Record.KV.find_opt "SCRIPT_NAME" params |> Option.value ~default:"" in
20
-
21
-
(* Log request info *)
22
-
Eio.traceln " Method: %s" method_;
23
-
Eio.traceln " URI: %s" uri;
24
-
Eio.traceln " Script: %s" script_name;
25
-
26
-
(* Generate simple HTTP response *)
27
-
let response_body =
28
-
Printf.sprintf
29
-
"<!DOCTYPE html>\n\
30
-
<html>\n\
31
-
<head><title>FastCGI OCaml Server</title></head>\n\
32
-
<body>\n\
33
-
<h1>FastCGI OCaml Server</h1>\n\
34
-
<p>Request processed successfully!</p>\n\
35
-
<ul>\n\
36
-
<li>Method: %s</li>\n\
37
-
<li>URI: %s</li>\n\
38
-
<li>Script: %s</li>\n\
39
-
</ul>\n\
40
-
<h2>All Parameters:</h2>\n\
41
-
<pre>%s</pre>\n\
42
-
</body>\n\
43
-
</html>\n"
44
-
method_ uri script_name
45
-
(let params_seq = Fastcgi.Record.KV.to_seq params in
46
-
let params_list = List.of_seq params_seq in
47
-
String.concat "\n" (List.map (fun (k, v) -> Printf.sprintf "%s = %s" k v) params_list))
48
-
in
49
-
50
-
(* Write HTTP response using FastCGI STDOUT records *)
51
-
let response_headers =
52
-
Printf.sprintf
53
-
"Status: 200 OK\r\n\
54
-
Content-Type: text/html; charset=utf-8\r\n\
55
-
Content-Length: %d\r\n\
56
-
\r\n"
57
-
(String.length response_body)
58
-
in
59
-
let full_response = response_headers ^ response_body in
60
-
61
-
(* Write STDOUT content *)
62
-
Fastcgi.Request.write_stdout_records output request.Fastcgi.Request.request_id full_response;
63
-
64
-
(* Write empty STDERR (no errors) *)
65
-
Fastcgi.Request.write_stderr_records output request.Fastcgi.Request.request_id "";
66
-
67
-
(* Write END_REQUEST with success status *)
68
-
Fastcgi.Request.write_end_request output request.Fastcgi.Request.request_id 0 Fastcgi.Request.Request_complete
69
-
in
70
-
62
+
71
63
(* Run the FastCGI server *)
72
-
Fastcgi.run server_socket
73
-
~on_error:(fun ex -> Eio.traceln "Error: %s" (Printexc.to_string ex))
64
+
Fastcgi.run server_socket
65
+
~on_error:(fun ex ->
66
+
Eio.traceln "Error: %s" (Printexc.to_string ex);
67
+
Eio.traceln "bt: %s" (Printexc.get_backtrace ()))
74
68
handler
75
69
76
70
let port =
···
82
76
let info = Cmd.info "fcgi-server" ~doc in
83
77
Cmd.v info Term.(const run $ port)
84
78
85
-
let () = exit (Cmd.eval cmd)
79
+
let () = exit (Cmd.eval cmd)
+32
-53
lib/fastcgi.ml
+32
-53
lib/fastcgi.ml
···
3
3
(** Request-level state machine and application interface *)
4
4
module Request = Fastcgi_request
5
5
6
-
(** Request handler function type *)
7
-
type handler = Request.t ->
8
-
stdout:Eio.Flow.sink_ty Eio.Resource.t ->
9
-
stderr:Eio.Flow.sink_ty Eio.Resource.t ->
10
-
Request.app_status
11
-
12
-
13
-
(** [write_response ~sw request ~stdout ~stderr sink app_status] writes FastCGI response.
14
-
Reads from stdout and stderr flows, converts to FastCGI records, and writes to sink.
15
-
Automatically handles stream termination and END_REQUEST. *)
16
-
let write_response ~sw:_ request ~stdout ~stderr sink app_status =
17
-
(* Read stdout content *)
18
-
let stdout_buf = Buffer.create 4096 in
19
-
Eio.Flow.copy stdout (Eio.Flow.buffer_sink stdout_buf);
20
-
let stdout_content = Buffer.contents stdout_buf in
21
-
22
-
(* Read stderr content *)
23
-
let stderr_buf = Buffer.create 1024 in
24
-
Eio.Flow.copy stderr (Eio.Flow.buffer_sink stderr_buf);
25
-
let stderr_content = Buffer.contents stderr_buf in
26
-
27
-
(* Write response using Buf_write *)
28
-
Eio.Buf_write.with_flow sink (fun buf_write ->
29
-
Request.write_stdout_records buf_write request.Request.request_id stdout_content;
30
-
Request.write_stderr_records buf_write request.Request.request_id stderr_content;
31
-
Request.write_end_request buf_write request.Request.request_id app_status Request.Request_complete
32
-
)
33
-
34
-
(** [process_request ~sw request handler sink] processes complete request.
35
-
Calls handler with flows for stdout/stderr output, then writes response to sink. *)
36
-
let process_request ~sw request handler sink =
37
-
(* Create in-memory flows for stdout and stderr *)
38
-
let stdout_buf = Buffer.create 4096 in
39
-
let stderr_buf = Buffer.create 1024 in
40
-
let stdout_sink = Eio.Flow.buffer_sink stdout_buf in
41
-
let stderr_sink = Eio.Flow.buffer_sink stderr_buf in
42
-
43
-
(* Call handler *)
44
-
let app_status = handler request ~stdout:stdout_sink ~stderr:stderr_sink in
45
-
46
-
(* Convert buffers to sources and write response *)
47
-
let stdout_source = Eio.Flow.string_source (Buffer.contents stdout_buf) in
48
-
let stderr_source = Eio.Flow.string_source (Buffer.contents stderr_buf) in
49
-
50
-
write_response ~sw request ~stdout:stdout_source ~stderr:stderr_source sink app_status
51
-
6
+
(* The lifetime of the handler is that the fiber should return when the
7
+
stdout and stderr flows are closed, or an abort request has been received *)
8
+
let handle req bw cancel fn =
9
+
let cancel () =
10
+
Eio.Promise.await cancel;
11
+
Eio.traceln "cancelled TODO"
12
+
in
13
+
let stdout buf = Request.write_stdout_records bw req.Request.request_id buf in
14
+
let stderr buf = Request.write_stderr_records bw req.Request.request_id buf in
15
+
let run () =
16
+
fn ~stdout ~stderr req;
17
+
Request.write_end_request bw req.Request.request_id 0 Request.Request_complete
18
+
in
19
+
Eio.Fiber.first run cancel
52
20
53
21
let run ?max_connections ?additional_domains ?stop ~on_error socket handler =
54
22
Eio.Net.run_server socket ?max_connections ?additional_domains ?stop ~on_error
55
23
(fun socket peer_address ->
24
+
let ids = Hashtbl.create 7 in
56
25
Eio.Switch.run @@ fun sw ->
57
26
Eio.traceln "%a: accept connection" Eio.Net.Sockaddr.pp peer_address;
58
27
let input = Eio.Buf_read.of_flow ~max_size:max_int socket in
59
-
try begin
60
-
Eio.Buf_write.with_flow socket @@ fun output ->
28
+
Eio.Buf_write.with_flow socket @@ fun output ->
29
+
let cont = ref true in
30
+
try while !cont do
61
31
match Request.read_request input with
62
32
| Error msg ->
63
33
Eio.traceln "%a: failed to read request: %s" Eio.Net.Sockaddr.pp peer_address msg;
64
-
Eio.Flow.close socket
34
+
failwith "done";
65
35
| Ok req ->
66
-
Eio.traceln "%a: read request %a" Eio.Net.Sockaddr.pp peer_address Request.pp req;
67
-
handler ~sw req output;
68
-
end
36
+
cont := req.Request.keep_conn;
37
+
Eio.traceln "%a: %b read request %a" Eio.Net.Sockaddr.pp peer_address !cont Request.pp req;
38
+
Eio.Fiber.fork ~sw (fun () ->
39
+
Eio.Switch.run ~name:"req_handler" @@ fun sw ->
40
+
let cancel, canceler = Eio.Promise.create () in
41
+
Hashtbl.add ids req.Request.request_id canceler;
42
+
Eio.Switch.on_release sw (fun () ->
43
+
Hashtbl.remove ids req.Request.request_id
44
+
);
45
+
handle req output cancel handler;
46
+
);
47
+
done
69
48
with Eio.Io (Eio.Net.E (Connection_reset _), _) ->
70
49
Eio.traceln "%a: connection reset" Eio.Net.Sockaddr.pp peer_address
71
-
)
50
+
)
+2
-26
lib/fastcgi.mli
+2
-26
lib/fastcgi.mli
···
14
14
15
15
(** {1 High-level Request Processing} *)
16
16
17
-
(** Request handler function type *)
18
-
type handler = Request.t ->
19
-
stdout:Eio.Flow.sink_ty Eio.Resource.t ->
20
-
stderr:Eio.Flow.sink_ty Eio.Resource.t ->
21
-
Request.app_status
22
-
23
-
(** [write_response ~sw request ~stdout ~stderr sink app_status] writes FastCGI response.
24
-
Reads from stdout and stderr flows, converts to FastCGI records, and writes to sink.
25
-
Automatically handles stream termination and END_REQUEST. *)
26
-
val write_response :
27
-
sw:Eio.Switch.t ->
28
-
Request.t ->
29
-
stdout:'a Eio.Flow.source ->
30
-
stderr:'a Eio.Flow.source ->
31
-
'a Eio.Flow.sink ->
32
-
Request.app_status -> unit
33
-
34
-
(** [process_request ~sw request handler sink] processes complete request.
35
-
Calls handler with flows for stdout/stderr output, then writes response to sink. *)
36
-
val process_request :
37
-
sw:Eio.Switch.t ->
38
-
Request.t ->
39
-
handler ->
40
-
Eio.Flow.sink_ty Eio.Resource.t -> unit
41
-
42
17
(** [handle_connection ~sw flow handler] handles complete FastCGI connection.
43
18
Reads requests from flow, processes them with handler, multiplexes responses.
44
19
Continues until connection is closed. *)
···
49
24
?stop:'a Eio__core.Promise.t ->
50
25
on_error:(exn -> unit) ->
51
26
[> [> `Generic ] Eio.Net.listening_socket_ty ] Eio.Resource.t ->
52
-
(sw:Eio.Switch.t -> Request.t -> Eio.Buf_write.t -> unit) -> 'a
27
+
(stdout:(string -> unit) ->
28
+
stderr:(string -> unit) -> Request.t -> unit) -> 'a
+27
-11
lib/fastcgi_record.ml
+27
-11
lib/fastcgi_record.ml
···
77
77
record_type : record;
78
78
request_id : request_id;
79
79
content : string;
80
+
offset : int;
81
+
length : int;
80
82
}
81
83
82
84
let pp ?(max_content_len=100) ppf record =
85
+
let actual_content = String.sub record.content record.offset record.length in
83
86
let truncated_content =
84
-
let content = record.content in
85
-
let len = String.length content in
86
-
if len <= max_content_len then content
87
-
else String.sub content 0 max_content_len ^ "..." ^ Printf.sprintf " (%d more bytes)" (len - max_content_len)
87
+
let len = String.length actual_content in
88
+
if len <= max_content_len then actual_content
89
+
else String.sub actual_content 0 max_content_len ^ "..." ^ Printf.sprintf " (%d more bytes)" (len - max_content_len)
88
90
in
89
91
Format.fprintf ppf
90
-
"@[<2>{ version = %d;@ record_type = %a;@ request_id = %d;@ content = %S }@]"
92
+
"@[<2>{ version = %d;@ record_type = %a;@ request_id = %d;@ content = %S;@ offset = %d;@ length = %d }@]"
91
93
record.version
92
94
pp_record record.record_type
93
95
record.request_id
94
96
truncated_content
97
+
record.offset
98
+
record.length
95
99
96
100
(* FastCGI constants *)
97
101
let fcgi_version_1 = 1
···
141
145
ignore (Eio.Buf_read.take padding_length buf_read)
142
146
);
143
147
144
-
let record = { version; record_type; request_id; content } in
148
+
let record = { version; record_type; request_id; content; offset = 0; length = String.length content } in
145
149
Printf.eprintf "[DEBUG] Fastcgi_record.read: Complete record = %s\n%!"
146
150
(Format.asprintf "%a" (pp ~max_content_len:50) record);
147
151
record
148
152
149
153
let write buf_write record =
150
-
let content_length = String.length record.content in
154
+
let total_content_length = String.length record.content in
155
+
let content_offset = record.offset in
156
+
let content_length = record.length in
157
+
158
+
(* Validate bounds *)
159
+
if content_offset < 0 || content_offset > total_content_length then
160
+
invalid_arg "Fastcgi_record.write: offset out of bounds";
161
+
if content_length < 0 || content_offset + content_length > total_content_length then
162
+
invalid_arg "Fastcgi_record.write: length out of bounds";
151
163
152
164
(* Calculate padding for 8-byte alignment *)
153
165
let padding_length = (8 - (content_length land 7)) land 7 in
···
163
175
164
176
Eio.Buf_write.string buf_write (Bytes.to_string header);
165
177
166
-
(* Write content *)
178
+
(* Write content with offset and length *)
167
179
if content_length > 0 then
168
-
Eio.Buf_write.string buf_write record.content;
180
+
Eio.Buf_write.string buf_write record.content ~off:content_offset ~len:content_length;
169
181
170
182
(* Write padding *)
171
183
if padding_length > 0 then
172
184
Eio.Buf_write.string buf_write (String.make padding_length '\000')
173
185
174
-
let create ~version ~record ~request_id ~content =
175
-
{ version; record_type = record; request_id; content }
186
+
let create ?(version=1) ~record ~request_id ~content ?(offset=0) ?length () =
187
+
let content_length = match length with
188
+
| None -> String.length content - offset
189
+
| Some l -> l
190
+
in
191
+
{ version; record_type = record; request_id; content; offset; length = content_length }
176
192
177
193
module KV = struct
178
194
type t = (string * string) list
+11
-7
lib/fastcgi_record.mli
+11
-7
lib/fastcgi_record.mli
···
43
43
content and optional padding for alignment. *)
44
44
type t = {
45
45
version : version; (** Protocol version (always 1) *)
46
-
record_type : record; (** Type of this record *)
46
+
record_type : record; (** Type of this record *)
47
47
request_id : request_id; (** Request identifier *)
48
48
content : string; (** Record content data *)
49
+
offset : int; (** Offset within content string (default: 0) *)
50
+
length : int; (** Length to use from content (default: String.length content) *)
49
51
}
50
52
51
53
(** [pp ?max_content_len ppf record] pretty-prints a FastCGI record.
···
63
65
(** [write buf_write record] writes a FastCGI record to the output buffer.
64
66
The record header is automatically constructed from the record fields,
65
67
and appropriate padding is added to align the record on 8-byte boundaries
66
-
for optimal performance. *)
68
+
for optimal performance. Uses the record's offset and length fields to
69
+
determine which portion of the content to write. *)
67
70
val write : Eio.Buf_write.t -> t -> unit
68
71
69
-
(** [create ~version ~record ~request_id ~content] creates a new record
70
-
with the specified parameters. The content length is automatically
71
-
calculated from the content string. *)
72
-
val create : version:version -> record:record ->
73
-
request_id:request_id -> content:string -> t
72
+
(** [create ?version ~record ~request_id ~content ?offset ?length] creates a new record
73
+
with the specified parameters. Version defaults to 1 (the only supported version).
74
+
If offset and length are not provided, the entire content string is used. *)
75
+
val create : ?version:version -> record:record ->
76
+
request_id:request_id -> content:string ->
77
+
?offset:int -> ?length:int -> unit -> t
74
78
75
79
(** {1 Key-Value Pairs} *)
76
80
+9
-44
lib/fastcgi_request.ml
+9
-44
lib/fastcgi_request.ml
···
240
240
| Overloaded -> 2
241
241
| Unknown_role -> 3
242
242
243
-
let 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
-
251
-
let 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
-
275
243
let write_stream_records buf_write request_id record_type content =
276
244
let max_chunk = 65535 in (* FastCGI max record content length *)
277
245
let len = String.length content in
278
-
279
246
let rec chunk_string pos =
280
-
if pos >= len then
281
-
() (* Empty terminator will be added separately *)
282
-
else
247
+
if pos < len then begin
283
248
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
249
+
let record = Fastcgi_record.create ~record:record_type ~request_id ~content ~offset:pos ~length:chunk_len () in
286
250
Fastcgi_record.write buf_write record;
287
251
chunk_string (pos + chunk_len)
252
+
end
288
253
in
289
-
290
254
chunk_string 0;
291
-
292
-
(* Add stream terminator *)
293
-
let terminator = Fastcgi_record.create ~version:1 ~record:record_type ~request_id ~content:"" in
255
+
let terminator = Fastcgi_record.create ~record:record_type ~request_id ~content:"" () in
294
256
Fastcgi_record.write buf_write terminator
295
257
296
258
let write_stdout_records buf_write request_id content =
259
+
Printf.eprintf "[DEBUG] write_stdout_records: Writing %d bytes for request_id=%d\n%!"
260
+
(String.length content) request_id;
297
261
write_stream_records buf_write request_id Stdout content
298
262
299
263
let write_stderr_records buf_write request_id content =
264
+
Printf.eprintf "[DEBUG] write_stderr_records: Writing %d bytes for request_id=%d\n%!"
265
+
(String.length content) request_id;
300
266
write_stream_records buf_write request_id Stderr content
301
267
302
268
let write_end_request buf_write request_id app_status protocol_status =
···
309
275
Bytes.set_uint8 buf 7 0; (* reserved *)
310
276
Bytes.to_string buf
311
277
in
312
-
let record = Fastcgi_record.create ~version:1 ~record:End_request ~request_id ~content in
278
+
let record = Fastcgi_record.create ~record:End_request ~request_id ~content () in
313
279
Fastcgi_record.write buf_write record
314
-
+2
-19
lib/fastcgi_request.mli
+2
-19
lib/fastcgi_request.mli
···
25
25
request_id : Fastcgi_record.request_id; (** Request identifier *)
26
26
role : role; (** Application role *)
27
27
keep_conn : bool; (** Connection keep-alive flag *)
28
-
params : Fastcgi_record.KV.t; (** Environment parameters *)
28
+
params : Fastcgi_record.KV.t; (** Environment parameters *)
29
29
stdin_data : string; (** Complete STDIN content *)
30
-
data_stream : string option; (** DATA stream for Filter role *)
30
+
data_stream : string option; (** DATA stream for Filter role *)
31
31
}
32
32
33
33
(** [pp ppf request] pretty-prints a request context *)
···
78
78
79
79
(** [write_end_request buf_write request_id app_status protocol_status] writes END_REQUEST record. *)
80
80
val write_end_request : Eio.Buf_write.t -> Fastcgi_record.request_id -> app_status -> protocol_status -> unit
81
-
82
-
83
-
(** {1 Utilities} *)
84
-
85
-
(** [is_stream_terminator record] returns true if record terminates a stream *)
86
-
val is_stream_terminator : Fastcgi_record.t -> bool
87
-
88
-
(** [stream_records_to_string records] concatenates content from stream records *)
89
-
val stream_records_to_string : Fastcgi_record.t list -> string
90
-
91
-
(** [string_to_stream_records ~request_id ~record_type content] converts string to stream records *)
92
-
val string_to_stream_records :
93
-
request_id:Fastcgi_record.request_id ->
94
-
record_type:Fastcgi_record.record ->
95
-
string -> Fastcgi_record.t list
96
-
97
-