FastCGI implementation in OCaml

start harness

+4
bin/dune
···
···
+
(executable
+
(public_name fcgi-server)
+
(name fcgi_server)
+
(libraries cmdliner eio eio_main fastcgi))
+32
bin/fcgi_server.ml
···
···
+
open Cmdliner
+
+
let run port =
+
Eio_main.run @@ fun env ->
+
Eio.Switch.run @@ fun sw ->
+
let net = Eio.Stdenv.net env in
+
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;
+
Eio.Net.run_server server_socket ~on_error:(fun ex -> Eio.traceln "Error: %s" (Printexc.to_string ex))
+
@@ fun flow addr ->
+
Eio.traceln "Accepted connection from %a" Eio.Net.Sockaddr.pp addr;
+
(* Here you would handle the FastCGI protocol, but for simplicity, we just echo a string. *)
+
let req = Fastcgi.Request.read_request_from_flow ~sw flow in
+
match req with
+
| Error msg ->
+
Eio.traceln "Failed to read request: %s" msg;
+
Eio.Flow.close flow
+
| Ok req ->
+
Eio.traceln "Received request: %a" Fastcgi.Request.pp req;
+
Eio.Flow.close flow
+
+
let port =
+
let doc = "Port to listen on" in
+
Arg.(value & opt int 9000 & info ["p"; "port"] ~docv:"PORT" ~doc)
+
+
let cmd =
+
let doc = "FastCGI server" in
+
let info = Cmd.info "fcgi-server" ~doc in
+
Cmd.v info Term.(const run $ port)
+
+
let () = exit (Cmd.eval cmd)
+3 -1
dune-project
···
(depends
ocaml
dune
-
eio)
(synopsis "FastCGI protocol implementation for OCaml using Eio")
(description "A type-safe implementation of the FastCGI protocol for OCaml using the Eio effects-based IO library. Supports all three FastCGI roles: Responder, Authorizer, and Filter."))
···
(depends
ocaml
dune
+
eio
+
cmdliner
+
eio_main)
(synopsis "FastCGI protocol implementation for OCaml using Eio")
(description "A type-safe implementation of the FastCGI protocol for OCaml using the Eio effects-based IO library. Supports all three FastCGI roles: Responder, Authorizer, and Filter."))
+2
fastcgi.opam
···
"ocaml"
"dune" {>= "3.0"}
"eio"
"odoc" {with-doc}
]
build: [
···
"ocaml"
"dune" {>= "3.0"}
"eio"
+
"cmdliner"
+
"eio_main"
"odoc" {with-doc}
]
build: [
+25 -6
lib/fastcgi_record.ml
···
let fcgi_header_len = 8
let read buf_read =
(* Read the 8-byte header *)
let header = Eio.Buf_read.take fcgi_header_len buf_read in
(* Parse header fields *)
···
let padding_length = Char.code header.[6] in
let _reserved = Char.code header.[7] in
(* Validate version *)
if version <> fcgi_version_1 then invalid_version version;
(* Convert record type *)
let record_type = record_of_int record_type_int in
(* Read content *)
let content =
-
if content_length = 0 then
""
-
else
-
Eio.Buf_read.take content_length buf_read
in
(* Skip padding *)
-
if padding_length > 0 then
-
ignore (Eio.Buf_read.take padding_length buf_read);
-
{ version; record_type; request_id; content }
let write buf_write record =
let content_length = String.length record.content in
···
let add key value kvs = (key, value) :: kvs
let remove key kvs = List.filter (fun (k, _) -> k <> key) kvs
let find key kvs =
try List.assoc key kvs
···
let fcgi_header_len = 8
let read buf_read =
+
Printf.eprintf "[DEBUG] Fastcgi_record.read: Starting to read record\n%!";
(* Read the 8-byte header *)
+
Printf.eprintf "[DEBUG] Fastcgi_record.read: Reading %d-byte header\n%!" fcgi_header_len;
let header = Eio.Buf_read.take fcgi_header_len buf_read in
(* Parse header fields *)
···
let padding_length = Char.code header.[6] in
let _reserved = Char.code header.[7] in
+
Printf.eprintf "[DEBUG] Fastcgi_record.read: Header parsed - version=%d, type=%d, id=%d, content_len=%d, padding=%d\n%!"
+
version record_type_int request_id content_length padding_length;
+
(* Validate version *)
if version <> fcgi_version_1 then invalid_version version;
(* Convert record type *)
let record_type = record_of_int record_type_int in
+
Printf.eprintf "[DEBUG] Fastcgi_record.read: Record type = %s\n%!"
+
(Format.asprintf "%a" pp_record record_type);
(* Read content *)
let content =
+
if content_length = 0 then (
+
Printf.eprintf "[DEBUG] Fastcgi_record.read: No content to read (length=0)\n%!";
""
+
) else (
+
Printf.eprintf "[DEBUG] Fastcgi_record.read: Reading %d bytes of content\n%!" content_length;
+
let c = Eio.Buf_read.take content_length buf_read in
+
Printf.eprintf "[DEBUG] Fastcgi_record.read: Successfully read %d bytes\n%!" (String.length c);
+
c
+
)
in
(* Skip padding *)
+
if padding_length > 0 then (
+
Printf.eprintf "[DEBUG] Fastcgi_record.read: Skipping %d bytes of padding\n%!" padding_length;
+
ignore (Eio.Buf_read.take padding_length buf_read)
+
);
+
let record = { version; record_type; request_id; 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 add key value kvs = (key, value) :: kvs
let remove key kvs = List.filter (fun (k, _) -> k <> key) kvs
+
+
let cardinal kvs = List.length kvs
let find key kvs =
try List.assoc key kvs
+3
lib/fastcgi_record.mli
···
(** [of_seq pairs] creates from a sequence of (key, value) tuples *)
val of_seq : (string * string) Seq.t -> t
(** [read buf_read] reads key-value pairs from a buffer.
Handles the FastCGI variable-length encoding where lengths ≤ 127 bytes
···
(** [of_seq pairs] creates from a sequence of (key, value) tuples *)
val of_seq : (string * string) Seq.t -> t
+
+
(** [cardinal pairs] returns the number of key-value pairs *)
+
val cardinal : t -> int
(** [read buf_read] reads key-value pairs from a buffer.
Handles the FastCGI variable-length encoding where lengths ≤ 127 bytes
+67 -19
lib/fastcgi_request.ml
···
String.length record.content = 0
-
let read_params_from_flow ~sw:_ flow =
-
let buf_read = Eio.Buf_read.of_flow flow ~max_size:1000000 in
let params = ref KV.empty in
let rec loop () =
try
let record = Fastcgi_record.read buf_read in
if record.record_type <> Params then
Error (Printf.sprintf "Expected PARAMS record, got %s"
(Format.asprintf "%a" pp_record record.record_type))
-
else if is_stream_terminator record then
Ok !params
-
else (
let record_params = KV.decode record.content in
params := KV.to_seq record_params
|> Seq.fold_left (fun acc (k, v) -> KV.add k v acc) !params;
loop ()
)
with
-
| End_of_file -> Error "Unexpected end of stream while reading PARAMS"
-
| exn -> Error (Printf.sprintf "Error reading PARAMS: %s" (Printexc.to_string exn))
in
loop ()
-
let read_stdin_from_flow ~sw:_ flow =
-
let buf_read = Eio.Buf_read.of_flow flow ~max_size:1000000 in
let data = Buffer.create 1024 in
let rec loop () =
try
let record = Fastcgi_record.read buf_read in
if record.record_type <> Stdin then
Error (Printf.sprintf "Expected STDIN record, got %s"
(Format.asprintf "%a" pp_record record.record_type))
-
else if is_stream_terminator record then
Ok (Buffer.contents data)
-
else (
Buffer.add_string data record.content;
loop ()
)
with
-
| End_of_file -> Error "Unexpected end of stream while reading STDIN"
-
| exn -> Error (Printf.sprintf "Error reading STDIN: %s" (Printexc.to_string exn))
in
loop ()
···
read_data ()
(** Read request streams based on role *)
-
let read_request_streams ~sw request flow buf_read =
match request.role with
| Authorizer ->
Ok request
| Responder ->
-
let* stdin_data = read_stdin_from_flow ~sw flow in
Ok { request with stdin_data }
| Filter ->
-
let* stdin_data = read_stdin_from_flow ~sw flow in
let request = { request with stdin_data } in
let* data = read_data_from_flow buf_read in
Ok { request with data_stream = Some data }
let read_request_from_flow ~sw flow =
let buf_read = Eio.Buf_read.of_flow flow ~max_size:1000000 in
try
(* Read BEGIN_REQUEST *)
let begin_record = Fastcgi_record.read buf_read in
let* request = create begin_record in
(* Read PARAMS stream *)
-
let* params = read_params_from_flow ~sw flow in
let request = { request with params } in
(* Read remaining streams based on role *)
-
read_request_streams ~sw request flow buf_read
with
-
| End_of_file -> Error "Unexpected end of stream"
-
| exn -> Error (Printf.sprintf "Error reading request: %s" (Printexc.to_string exn))
(** {1 Response Generation} *)
···
String.length record.content = 0
+
let read_params_from_flow ~sw:_ buf_read =
+
Printf.eprintf "[DEBUG] read_params_from_flow: Starting\n%!";
let params = ref KV.empty in
let rec loop () =
try
+
Printf.eprintf "[DEBUG] read_params_from_flow: Reading next PARAMS record\n%!";
let record = Fastcgi_record.read buf_read in
+
Printf.eprintf "[DEBUG] read_params_from_flow: Got record type=%s, content_length=%d\n%!"
+
(Format.asprintf "%a" pp_record record.record_type)
+
(String.length record.content);
if record.record_type <> Params then
Error (Printf.sprintf "Expected PARAMS record, got %s"
(Format.asprintf "%a" pp_record record.record_type))
+
else if is_stream_terminator record then (
+
Printf.eprintf "[DEBUG] read_params_from_flow: Got stream terminator, returning %d params\n%!"
+
(Fastcgi_record.KV.cardinal !params);
Ok !params
+
) else (
let record_params = KV.decode record.content in
+
Printf.eprintf "[DEBUG] read_params_from_flow: Decoded %d params from record\n%!"
+
(Fastcgi_record.KV.cardinal record_params);
params := KV.to_seq record_params
|> Seq.fold_left (fun acc (k, v) -> KV.add k v acc) !params;
loop ()
)
with
+
| End_of_file ->
+
Printf.eprintf "[DEBUG] read_params_from_flow: Hit End_of_file\n%!";
+
Error "Unexpected end of stream while reading PARAMS"
+
| exn ->
+
Printf.eprintf "[DEBUG] read_params_from_flow: Exception: %s\n%!" (Printexc.to_string exn);
+
Error (Printf.sprintf "Error reading PARAMS: %s" (Printexc.to_string exn))
in
loop ()
+
let read_stdin_from_flow ~sw:_ buf_read =
+
Printf.eprintf "[DEBUG] read_stdin_from_flow: Starting\n%!";
let data = Buffer.create 1024 in
let rec loop () =
try
+
Printf.eprintf "[DEBUG] read_stdin_from_flow: Reading next STDIN record\n%!";
let record = Fastcgi_record.read buf_read in
+
Printf.eprintf "[DEBUG] read_stdin_from_flow: Got record type=%s, content_length=%d\n%!"
+
(Format.asprintf "%a" pp_record record.record_type)
+
(String.length record.content);
if record.record_type <> Stdin then
Error (Printf.sprintf "Expected STDIN record, got %s"
(Format.asprintf "%a" pp_record record.record_type))
+
else if is_stream_terminator record then (
+
Printf.eprintf "[DEBUG] read_stdin_from_flow: Got stream terminator, total stdin=%d bytes\n%!"
+
(Buffer.length data);
Ok (Buffer.contents data)
+
) else (
Buffer.add_string data record.content;
+
Printf.eprintf "[DEBUG] read_stdin_from_flow: Added %d bytes, total now %d\n%!"
+
(String.length record.content) (Buffer.length data);
loop ()
)
with
+
| End_of_file ->
+
Printf.eprintf "[DEBUG] read_stdin_from_flow: Hit End_of_file\n%!";
+
Error "Unexpected end of stream while reading STDIN"
+
| exn ->
+
Printf.eprintf "[DEBUG] read_stdin_from_flow: Exception: %s\n%!" (Printexc.to_string exn);
+
Error (Printf.sprintf "Error reading STDIN: %s" (Printexc.to_string exn))
in
loop ()
···
read_data ()
(** Read request streams based on role *)
+
let read_request_streams ~sw request buf_read =
+
Printf.eprintf "[DEBUG] read_request_streams: Processing role=%s\n%!"
+
(Format.asprintf "%a" pp_role request.role);
match request.role with
| Authorizer ->
+
Printf.eprintf "[DEBUG] read_request_streams: Authorizer role, no streams to read\n%!";
Ok request
| Responder ->
+
Printf.eprintf "[DEBUG] read_request_streams: Responder role, reading STDIN\n%!";
+
let* stdin_data = read_stdin_from_flow ~sw buf_read in
+
Printf.eprintf "[DEBUG] read_request_streams: Got STDIN data, %d bytes\n%!" (String.length stdin_data);
Ok { request with stdin_data }
| Filter ->
+
Printf.eprintf "[DEBUG] read_request_streams: Filter role, reading STDIN and DATA\n%!";
+
let* stdin_data = read_stdin_from_flow ~sw buf_read in
+
Printf.eprintf "[DEBUG] read_request_streams: Got STDIN data, %d bytes\n%!" (String.length stdin_data);
let request = { request with stdin_data } in
let* data = read_data_from_flow buf_read in
+
Printf.eprintf "[DEBUG] read_request_streams: Got DATA stream, %d bytes\n%!" (String.length data);
Ok { request with data_stream = Some data }
let read_request_from_flow ~sw flow =
+
Printf.eprintf "[DEBUG] read_request_from_flow: Starting\n%!";
let buf_read = Eio.Buf_read.of_flow flow ~max_size:1000000 in
try
(* Read BEGIN_REQUEST *)
+
Printf.eprintf "[DEBUG] read_request_from_flow: Reading BEGIN_REQUEST record\n%!";
let begin_record = Fastcgi_record.read buf_read in
+
Printf.eprintf "[DEBUG] read_request_from_flow: Got BEGIN_REQUEST record: %s\n%!"
+
(Format.asprintf "%a" (Fastcgi_record.pp ~max_content_len:50) begin_record);
let* request = create begin_record in
+
Printf.eprintf "[DEBUG] read_request_from_flow: Created request with role=%s, id=%d\n%!"
+
(Format.asprintf "%a" pp_role request.role) request.request_id;
(* Read PARAMS stream *)
+
Printf.eprintf "[DEBUG] read_request_from_flow: Reading PARAMS stream\n%!";
+
let* params = read_params_from_flow ~sw buf_read in
+
Printf.eprintf "[DEBUG] read_request_from_flow: Got %d params\n%!" (Fastcgi_record.KV.cardinal params);
let request = { request with params } in
(* Read remaining streams based on role *)
+
Printf.eprintf "[DEBUG] read_request_from_flow: Reading streams for role=%s\n%!"
+
(Format.asprintf "%a" pp_role request.role);
+
let result = read_request_streams ~sw request buf_read in
+
Printf.eprintf "[DEBUG] read_request_from_flow: Finished reading request\n%!";
+
result
with
+
| End_of_file ->
+
Printf.eprintf "[DEBUG] read_request_from_flow: Hit End_of_file\n%!";
+
Error "Unexpected end of stream"
+
| exn ->
+
Printf.eprintf "[DEBUG] read_request_from_flow: Exception: %s\n%!" (Printexc.to_string exn);
+
Error (Printf.sprintf "Error reading request: %s" (Printexc.to_string exn))
(** {1 Response Generation} *)
+4 -4
lib/fastcgi_request.mli
···
Returns the populated request context. *)
val read_request_from_flow : sw:Eio.Switch.t -> 'a Eio.Flow.source -> (t, string) result
-
(** [read_params_from_flow ~sw flow] reads PARAMS stream from flow until empty record.
Returns the accumulated parameters. *)
-
val read_params_from_flow : sw:Eio.Switch.t -> 'a Eio.Flow.source -> (Fastcgi_record.KV.t, string) result
-
(** [read_stdin_from_flow ~sw flow] reads STDIN stream from flow until empty record.
Returns the accumulated data. *)
-
val read_stdin_from_flow : sw:Eio.Switch.t -> 'a Eio.Flow.source -> (string, string) result
(** {1 Response Generation} *)
···
Returns the populated request context. *)
val read_request_from_flow : sw:Eio.Switch.t -> 'a Eio.Flow.source -> (t, string) result
+
(** [read_params_from_flow ~sw buf_read] reads PARAMS stream from buf_read until empty record.
Returns the accumulated parameters. *)
+
val read_params_from_flow : sw:Eio.Switch.t -> Eio.Buf_read.t -> (Fastcgi_record.KV.t, string) result
+
(** [read_stdin_from_flow ~sw buf_read] reads STDIN stream from buf_read until empty record.
Returns the accumulated data. *)
+
val read_stdin_from_flow : sw:Eio.Switch.t -> Eio.Buf_read.t -> (string, string) result
(** {1 Response Generation} *)
+2
test/dune
···
(test
(name simple_test)
(libraries fastcgi eio eio_main)
(deps (source_tree test_cases))
)
(test
(name validate_all_test_cases)
(libraries fastcgi eio eio_main)
(deps (source_tree test_cases))
)
···
(test
(name simple_test)
+
(modules simple_test)
(libraries fastcgi eio eio_main)
(deps (source_tree test_cases))
)
(test
(name validate_all_test_cases)
+
(modules validate_all_test_cases)
(libraries fastcgi eio eio_main)
(deps (source_tree test_cases))
)