FastCGI implementation in OCaml

more

+58 -64
bin/fcgi_server.ml
···
open Cmdliner
+
(* Handler function that processes FastCGI requests *)
+
let handler ~stdout ~stderr request =
+
Eio.traceln "Processing request: %a" Fastcgi.Request.pp request;
+
+
(* Get request parameters *)
+
let params = request.Fastcgi.Request.params in
+
let method_ = Fastcgi.Record.KV.find_opt "REQUEST_METHOD" params |> Option.value ~default:"GET" in
+
let uri = Fastcgi.Record.KV.find_opt "REQUEST_URI" params |> Option.value ~default:"/" in
+
let script_name = Fastcgi.Record.KV.find_opt "SCRIPT_NAME" params |> Option.value ~default:"" in
+
+
(* Log request info *)
+
Eio.traceln " Method: %s" method_;
+
Eio.traceln " URI: %s" uri;
+
Eio.traceln " Script: %s" script_name;
+
+
(* Generate simple HTTP response *)
+
let response_body =
+
Printf.sprintf
+
"<!DOCTYPE html>\n\
+
<html>\n\
+
<head><title>FastCGI OCaml Server</title></head>\n\
+
<body>\n\
+
<h1>FastCGI OCaml Server</h1>\n\
+
<p>Request processed successfully!</p>\n\
+
<ul>\n\
+
<li>Method: %s</li>\n\
+
<li>URI: %s</li>\n\
+
<li>Script: %s</li>\n\
+
</ul>\n\
+
<h2>All Parameters:</h2>\n\
+
<pre>%s</pre>\n\
+
</body>\n\
+
</html>\n"
+
method_ uri script_name
+
(let params_seq = Fastcgi.Record.KV.to_seq params in
+
let params_list = List.of_seq params_seq in
+
String.concat "\n" (List.map (fun (k, v) -> Printf.sprintf "%s = %s" k v) params_list))
+
in
+
+
(* Write HTTP response using FastCGI STDOUT records *)
+
let response_headers =
+
Printf.sprintf
+
"Status: 200 OK\r\n\
+
Content-Type: text/html; charset=utf-8\r\n\
+
Content-Length: %d\r\n\
+
\r\n"
+
(String.length response_body)
+
in
+
stdout response_headers;
+
stderr "stderr stuff";
+
stdout response_body
+
let run port =
Eio_main.run @@ fun env ->
Eio.Switch.run @@ fun sw ->
···
let addr = `Tcp (Eio.Net.Ipaddr.V4.loopback, port) in
let server_socket = Eio.Net.listen net ~backlog:10 ~reuse_addr:true ~sw addr in
Eio.traceln "FastCGI server listening on port %d" port;
-
-
(* Handler function that processes FastCGI requests *)
-
let handler ~sw:_ request output =
-
Eio.traceln "Processing request: %a" Fastcgi.Request.pp request;
-
-
(* Get request parameters *)
-
let params = request.Fastcgi.Request.params in
-
let method_ = Fastcgi.Record.KV.find_opt "REQUEST_METHOD" params |> Option.value ~default:"GET" in
-
let uri = Fastcgi.Record.KV.find_opt "REQUEST_URI" params |> Option.value ~default:"/" in
-
let script_name = Fastcgi.Record.KV.find_opt "SCRIPT_NAME" params |> Option.value ~default:"" in
-
-
(* Log request info *)
-
Eio.traceln " Method: %s" method_;
-
Eio.traceln " URI: %s" uri;
-
Eio.traceln " Script: %s" script_name;
-
-
(* Generate simple HTTP response *)
-
let response_body =
-
Printf.sprintf
-
"<!DOCTYPE html>\n\
-
<html>\n\
-
<head><title>FastCGI OCaml Server</title></head>\n\
-
<body>\n\
-
<h1>FastCGI OCaml Server</h1>\n\
-
<p>Request processed successfully!</p>\n\
-
<ul>\n\
-
<li>Method: %s</li>\n\
-
<li>URI: %s</li>\n\
-
<li>Script: %s</li>\n\
-
</ul>\n\
-
<h2>All Parameters:</h2>\n\
-
<pre>%s</pre>\n\
-
</body>\n\
-
</html>\n"
-
method_ uri script_name
-
(let params_seq = Fastcgi.Record.KV.to_seq params in
-
let params_list = List.of_seq params_seq in
-
String.concat "\n" (List.map (fun (k, v) -> Printf.sprintf "%s = %s" k v) params_list))
-
in
-
-
(* Write HTTP response using FastCGI STDOUT records *)
-
let response_headers =
-
Printf.sprintf
-
"Status: 200 OK\r\n\
-
Content-Type: text/html; charset=utf-8\r\n\
-
Content-Length: %d\r\n\
-
\r\n"
-
(String.length response_body)
-
in
-
let full_response = response_headers ^ response_body in
-
-
(* Write STDOUT content *)
-
Fastcgi.Request.write_stdout_records output request.Fastcgi.Request.request_id full_response;
-
-
(* Write empty STDERR (no errors) *)
-
Fastcgi.Request.write_stderr_records output request.Fastcgi.Request.request_id "";
-
-
(* Write END_REQUEST with success status *)
-
Fastcgi.Request.write_end_request output request.Fastcgi.Request.request_id 0 Fastcgi.Request.Request_complete
-
in
-
+
(* Run the FastCGI server *)
-
Fastcgi.run server_socket
-
~on_error:(fun ex -> Eio.traceln "Error: %s" (Printexc.to_string ex))
+
Fastcgi.run server_socket
+
~on_error:(fun ex ->
+
Eio.traceln "Error: %s" (Printexc.to_string ex);
+
Eio.traceln "bt: %s" (Printexc.get_backtrace ()))
handler
let port =
···
let info = Cmd.info "fcgi-server" ~doc in
Cmd.v info Term.(const run $ port)
-
let () = exit (Cmd.eval cmd)
+
let () = exit (Cmd.eval cmd)
+32 -53
lib/fastcgi.ml
···
(** Request-level state machine and application interface *)
module Request = Fastcgi_request
-
(** Request handler function type *)
-
type handler = Request.t ->
-
stdout:Eio.Flow.sink_ty Eio.Resource.t ->
-
stderr:Eio.Flow.sink_ty Eio.Resource.t ->
-
Request.app_status
-
-
-
(** [write_response ~sw request ~stdout ~stderr sink app_status] writes FastCGI response.
-
Reads from stdout and stderr flows, converts to FastCGI records, and writes to sink.
-
Automatically handles stream termination and END_REQUEST. *)
-
let write_response ~sw:_ request ~stdout ~stderr sink app_status =
-
(* Read stdout content *)
-
let stdout_buf = Buffer.create 4096 in
-
Eio.Flow.copy stdout (Eio.Flow.buffer_sink stdout_buf);
-
let stdout_content = Buffer.contents stdout_buf in
-
-
(* Read stderr content *)
-
let stderr_buf = Buffer.create 1024 in
-
Eio.Flow.copy stderr (Eio.Flow.buffer_sink stderr_buf);
-
let stderr_content = Buffer.contents stderr_buf in
-
-
(* Write response using Buf_write *)
-
Eio.Buf_write.with_flow sink (fun buf_write ->
-
Request.write_stdout_records buf_write request.Request.request_id stdout_content;
-
Request.write_stderr_records buf_write request.Request.request_id stderr_content;
-
Request.write_end_request buf_write request.Request.request_id app_status Request.Request_complete
-
)
-
-
(** [process_request ~sw request handler sink] processes complete request.
-
Calls handler with flows for stdout/stderr output, then writes response to sink. *)
-
let process_request ~sw request handler sink =
-
(* Create in-memory flows for stdout and stderr *)
-
let stdout_buf = Buffer.create 4096 in
-
let stderr_buf = Buffer.create 1024 in
-
let stdout_sink = Eio.Flow.buffer_sink stdout_buf in
-
let stderr_sink = Eio.Flow.buffer_sink stderr_buf in
-
-
(* Call handler *)
-
let app_status = handler request ~stdout:stdout_sink ~stderr:stderr_sink in
-
-
(* Convert buffers to sources and write response *)
-
let stdout_source = Eio.Flow.string_source (Buffer.contents stdout_buf) in
-
let stderr_source = Eio.Flow.string_source (Buffer.contents stderr_buf) in
-
-
write_response ~sw request ~stdout:stdout_source ~stderr:stderr_source sink app_status
-
+
(* The lifetime of the handler is that the fiber should return when the
+
stdout and stderr flows are closed, or an abort request has been received *)
+
let handle req bw cancel fn =
+
let cancel () =
+
Eio.Promise.await cancel;
+
Eio.traceln "cancelled TODO"
+
in
+
let stdout buf = Request.write_stdout_records bw req.Request.request_id buf in
+
let stderr buf = Request.write_stderr_records bw req.Request.request_id buf in
+
let run () =
+
fn ~stdout ~stderr req;
+
Request.write_end_request bw req.Request.request_id 0 Request.Request_complete
+
in
+
Eio.Fiber.first run cancel
let run ?max_connections ?additional_domains ?stop ~on_error socket handler =
Eio.Net.run_server socket ?max_connections ?additional_domains ?stop ~on_error
(fun socket peer_address ->
+
let ids = Hashtbl.create 7 in
Eio.Switch.run @@ fun sw ->
Eio.traceln "%a: accept connection" Eio.Net.Sockaddr.pp peer_address;
let input = Eio.Buf_read.of_flow ~max_size:max_int socket in
-
try begin
-
Eio.Buf_write.with_flow socket @@ fun output ->
+
Eio.Buf_write.with_flow socket @@ fun output ->
+
let cont = ref true in
+
try while !cont do
match Request.read_request input with
| Error msg ->
Eio.traceln "%a: failed to read request: %s" Eio.Net.Sockaddr.pp peer_address msg;
-
Eio.Flow.close socket
+
failwith "done";
| Ok req ->
-
Eio.traceln "%a: read request %a" Eio.Net.Sockaddr.pp peer_address Request.pp req;
-
handler ~sw req output;
-
end
+
cont := req.Request.keep_conn;
+
Eio.traceln "%a: %b read request %a" Eio.Net.Sockaddr.pp peer_address !cont Request.pp req;
+
Eio.Fiber.fork ~sw (fun () ->
+
Eio.Switch.run ~name:"req_handler" @@ fun sw ->
+
let cancel, canceler = Eio.Promise.create () in
+
Hashtbl.add ids req.Request.request_id canceler;
+
Eio.Switch.on_release sw (fun () ->
+
Hashtbl.remove ids req.Request.request_id
+
);
+
handle req output cancel handler;
+
);
+
done
with Eio.Io (Eio.Net.E (Connection_reset _), _) ->
Eio.traceln "%a: connection reset" Eio.Net.Sockaddr.pp peer_address
-
)
+
)
+2 -26
lib/fastcgi.mli
···
(** {1 High-level Request Processing} *)
-
(** Request handler function type *)
-
type handler = Request.t ->
-
stdout:Eio.Flow.sink_ty Eio.Resource.t ->
-
stderr:Eio.Flow.sink_ty Eio.Resource.t ->
-
Request.app_status
-
-
(** [write_response ~sw request ~stdout ~stderr sink app_status] writes FastCGI response.
-
Reads from stdout and stderr flows, converts to FastCGI records, and writes to sink.
-
Automatically handles stream termination and END_REQUEST. *)
-
val write_response :
-
sw:Eio.Switch.t ->
-
Request.t ->
-
stdout:'a Eio.Flow.source ->
-
stderr:'a Eio.Flow.source ->
-
'a Eio.Flow.sink ->
-
Request.app_status -> unit
-
-
(** [process_request ~sw request handler sink] processes complete request.
-
Calls handler with flows for stdout/stderr output, then writes response to sink. *)
-
val process_request :
-
sw:Eio.Switch.t ->
-
Request.t ->
-
handler ->
-
Eio.Flow.sink_ty Eio.Resource.t -> unit
-
(** [handle_connection ~sw flow handler] handles complete FastCGI connection.
Reads requests from flow, processes them with handler, multiplexes responses.
Continues until connection is closed. *)
···
?stop:'a Eio__core.Promise.t ->
on_error:(exn -> unit) ->
[> [> `Generic ] Eio.Net.listening_socket_ty ] Eio.Resource.t ->
-
(sw:Eio.Switch.t -> Request.t -> Eio.Buf_write.t -> unit) -> 'a
+
(stdout:(string -> unit) ->
+
stderr:(string -> unit) -> Request.t -> unit) -> 'a
+27 -11
lib/fastcgi_record.ml
···
record_type : record;
request_id : request_id;
content : string;
+
offset : int;
+
length : int;
}
let pp ?(max_content_len=100) ppf record =
+
let actual_content = String.sub record.content record.offset record.length in
let truncated_content =
-
let content = record.content in
-
let len = String.length content in
-
if len <= max_content_len then content
-
else String.sub content 0 max_content_len ^ "..." ^ Printf.sprintf " (%d more bytes)" (len - max_content_len)
+
let len = String.length actual_content in
+
if len <= max_content_len then actual_content
+
else String.sub actual_content 0 max_content_len ^ "..." ^ Printf.sprintf " (%d more bytes)" (len - max_content_len)
in
Format.fprintf ppf
-
"@[<2>{ version = %d;@ record_type = %a;@ request_id = %d;@ content = %S }@]"
+
"@[<2>{ version = %d;@ record_type = %a;@ request_id = %d;@ content = %S;@ offset = %d;@ length = %d }@]"
record.version
pp_record record.record_type
record.request_id
truncated_content
+
record.offset
+
record.length
(* FastCGI constants *)
let fcgi_version_1 = 1
···
ignore (Eio.Buf_read.take padding_length buf_read)
);
-
let record = { version; record_type; request_id; content } in
+
let record = { version; record_type; request_id; content; offset = 0; length = String.length content } in
Printf.eprintf "[DEBUG] Fastcgi_record.read: Complete record = %s\n%!"
(Format.asprintf "%a" (pp ~max_content_len:50) record);
record
let write buf_write record =
-
let content_length = String.length record.content in
+
let total_content_length = String.length record.content in
+
let content_offset = record.offset in
+
let content_length = record.length in
+
+
(* Validate bounds *)
+
if content_offset < 0 || content_offset > total_content_length then
+
invalid_arg "Fastcgi_record.write: offset out of bounds";
+
if content_length < 0 || content_offset + content_length > total_content_length then
+
invalid_arg "Fastcgi_record.write: length out of bounds";
(* Calculate padding for 8-byte alignment *)
let padding_length = (8 - (content_length land 7)) land 7 in
···
Eio.Buf_write.string buf_write (Bytes.to_string header);
-
(* Write content *)
+
(* Write content with offset and length *)
if content_length > 0 then
-
Eio.Buf_write.string buf_write record.content;
+
Eio.Buf_write.string buf_write record.content ~off:content_offset ~len:content_length;
(* Write padding *)
if padding_length > 0 then
Eio.Buf_write.string buf_write (String.make padding_length '\000')
-
let create ~version ~record ~request_id ~content =
-
{ version; record_type = record; request_id; content }
+
let create ?(version=1) ~record ~request_id ~content ?(offset=0) ?length () =
+
let content_length = match length with
+
| None -> String.length content - offset
+
| Some l -> l
+
in
+
{ version; record_type = record; request_id; content; offset; length = content_length }
module KV = struct
type t = (string * string) list
+11 -7
lib/fastcgi_record.mli
···
content and optional padding for alignment. *)
type t = {
version : version; (** Protocol version (always 1) *)
-
record_type : record; (** Type of this record *)
+
record_type : record; (** Type of this record *)
request_id : request_id; (** Request identifier *)
content : string; (** Record content data *)
+
offset : int; (** Offset within content string (default: 0) *)
+
length : int; (** Length to use from content (default: String.length content) *)
}
(** [pp ?max_content_len ppf record] pretty-prints a FastCGI record.
···
(** [write buf_write record] writes a FastCGI record to the output buffer.
The record header is automatically constructed from the record fields,
and appropriate padding is added to align the record on 8-byte boundaries
-
for optimal performance. *)
+
for optimal performance. Uses the record's offset and length fields to
+
determine which portion of the content to write. *)
val write : Eio.Buf_write.t -> t -> unit
-
(** [create ~version ~record ~request_id ~content] creates a new record
-
with the specified parameters. The content length is automatically
-
calculated from the content string. *)
-
val create : version:version -> record:record ->
-
request_id:request_id -> content:string -> t
+
(** [create ?version ~record ~request_id ~content ?offset ?length] creates a new record
+
with the specified parameters. Version defaults to 1 (the only supported version).
+
If offset and length are not provided, the entire content string is used. *)
+
val create : ?version:version -> record:record ->
+
request_id:request_id -> content:string ->
+
?offset:int -> ?length:int -> unit -> t
(** {1 Key-Value Pairs} *)
+9 -44
lib/fastcgi_request.ml
···
| Overloaded -> 2
| Unknown_role -> 3
-
let stream_records_to_string records =
-
let buf = Buffer.create 1024 in
-
List.iter (fun record ->
-
if not (is_stream_terminator record) then
-
Buffer.add_string buf record.content
-
) records;
-
Buffer.contents buf
-
-
let string_to_stream_records ~request_id ~record_type content =
-
let max_chunk = 65535 in (* FastCGI max record content length *)
-
let len = String.length content in
-
let records = ref [] in
-
-
let rec chunk_string pos =
-
if pos >= len then
-
() (* Empty terminator will be added separately *)
-
else
-
let chunk_len = min max_chunk (len - pos) in
-
let chunk = String.sub content pos chunk_len in
-
let record = Fastcgi_record.create ~version:1 ~record:record_type ~request_id ~content:chunk in
-
records := record :: !records;
-
chunk_string (pos + chunk_len)
-
in
-
-
chunk_string 0;
-
-
(* Add stream terminator *)
-
let terminator = Fastcgi_record.create ~version:1 ~record:record_type ~request_id ~content:"" in
-
records := terminator :: !records;
-
-
List.rev !records
-
let write_stream_records buf_write request_id record_type content =
let max_chunk = 65535 in (* FastCGI max record content length *)
let len = String.length content in
-
let rec chunk_string pos =
-
if pos >= len then
-
() (* Empty terminator will be added separately *)
-
else
+
if pos < len then begin
let chunk_len = min max_chunk (len - pos) in
-
let chunk = String.sub content pos chunk_len in
-
let record = Fastcgi_record.create ~version:1 ~record:record_type ~request_id ~content:chunk in
+
let record = Fastcgi_record.create ~record:record_type ~request_id ~content ~offset:pos ~length:chunk_len () in
Fastcgi_record.write buf_write record;
chunk_string (pos + chunk_len)
+
end
in
-
chunk_string 0;
-
-
(* Add stream terminator *)
-
let terminator = Fastcgi_record.create ~version:1 ~record:record_type ~request_id ~content:"" in
+
let terminator = Fastcgi_record.create ~record:record_type ~request_id ~content:"" () in
Fastcgi_record.write buf_write terminator
let write_stdout_records buf_write request_id content =
+
Printf.eprintf "[DEBUG] write_stdout_records: Writing %d bytes for request_id=%d\n%!"
+
(String.length content) request_id;
write_stream_records buf_write request_id Stdout content
let write_stderr_records buf_write request_id content =
+
Printf.eprintf "[DEBUG] write_stderr_records: Writing %d bytes for request_id=%d\n%!"
+
(String.length content) request_id;
write_stream_records buf_write request_id Stderr content
let write_end_request buf_write request_id app_status protocol_status =
···
Bytes.set_uint8 buf 7 0; (* reserved *)
Bytes.to_string buf
in
-
let record = Fastcgi_record.create ~version:1 ~record:End_request ~request_id ~content in
+
let record = Fastcgi_record.create ~record:End_request ~request_id ~content () in
Fastcgi_record.write buf_write record
-
+2 -19
lib/fastcgi_request.mli
···
request_id : Fastcgi_record.request_id; (** Request identifier *)
role : role; (** Application role *)
keep_conn : bool; (** Connection keep-alive flag *)
-
params : Fastcgi_record.KV.t; (** Environment parameters *)
+
params : Fastcgi_record.KV.t; (** Environment parameters *)
stdin_data : string; (** Complete STDIN content *)
-
data_stream : string option; (** DATA stream for Filter role *)
+
data_stream : string option; (** DATA stream for Filter role *)
}
(** [pp ppf request] pretty-prints a request context *)
···
(** [write_end_request buf_write request_id app_status protocol_status] writes END_REQUEST record. *)
val write_end_request : Eio.Buf_write.t -> Fastcgi_record.request_id -> app_status -> protocol_status -> unit
-
-
-
(** {1 Utilities} *)
-
-
(** [is_stream_terminator record] returns true if record terminates a stream *)
-
val is_stream_terminator : Fastcgi_record.t -> bool
-
-
(** [stream_records_to_string records] concatenates content from stream records *)
-
val stream_records_to_string : Fastcgi_record.t list -> string
-
-
(** [string_to_stream_records ~request_id ~record_type content] converts string to stream records *)
-
val string_to_stream_records :
-
request_id:Fastcgi_record.request_id ->
-
record_type:Fastcgi_record.record ->
-
string -> Fastcgi_record.t list
-
-