comparing spec and main on anil.recoil.org/ocaml-fastcgi

.gitignore

···

       1
       1
       +
       _build

+98 -2

CLAUDE.md

···

       1
       1
       -
       This branch exists to figure out an OCaml specification for the FastCGI interface.

     

       1
       1
       +
       This repository exists to implement an OCaml specification for the FastCGI interface.

     

       2
       2
        
       

     

       3
       3
        
       The spec for the FastCGI protocol is in spec/FastCGI_Specification.html.

     

       4
       4
        
       The Go lang implementation of FastCGI is in spec/fcgi.go.

     

       5
       5
       +
       An OCaml specification exists in spec/OCAML.md.

     

       5
       6
        
       

     

       6
       6
       -
       Both of these are intended to act as a reference implementation, for us to figure out what the ideal OCaml interface should look like for FastCGI.

     

       7
       7
       +
       These are intended to act as a reference implementation for us to figure out what the ideal OCaml interface should look like for FastCGI.

     

       7
       8
        
       

     

       8
       9
        
       Our target language is OCaml, using the Eio library. The README for Eio is in OCaml-EIO-README.md to give you a reference.

     

       10
       10
       +
       The parsing and serialisation should be done using Eio's Buf_read and Buf_write modules.

     

       11
       11
       +
       

     

       12
       12
       +
       You can run commands with:

     

       13
       13
       +
       

     

       14
       14
       +
       - clean: `opam exec -- dune clean`

     

       15
       15
       +
       - build: `opam exec -- dune build @check`

     

       16
       16
       +
       - docs: `opam exec -- dune build @doc`

     

       17
       17
       +
       - build while ignoring warnings: add `--profile=release` to the CLI to activate the profile that ignores warnings

     

       18
       18
       +
       

     

       19
       19
       +
       # Tips on fixing bugs

     

       20
       20
       +
       

     

       21
       21
       +
       If you see errors like this:

     

       22
       22
       +
       

     

       23
       23
       +
       ```

     

       24
       24
       +
       File "../../.jmap.objs/byte/jmap.odoc":

     

       25
       25
       +
       Warning: Hidden fields in type 'Jmap.Email.Identity.identity_create'

     

       26
       26
       +
       ```

     

       27
       27
       +
       

     

       28
       28
       +
       Then examine the HTML docs built for that module. You will see that there are module references with __ in them, e.g. "Jmap__.Jmap_email_types.Email_address.t" which indicate that the module is being accessed directly instead of via the module aliases defined.

     

       29
       29
       +
       

     

       30
       30
       +
       ## Documentation Comments

     

       31
       31
       +
       

     

       32
       32
       +
       When adding OCaml documentation comments, be careful about ambiguous documentation comments. If you see errors like:

     

       33
       33
       +
       

     

       34
       34
       +
       ```

     

       35
       35
       +
       Error (warning 50 [unexpected-docstring]): ambiguous documentation comment

     

       36
       36
       +
       ```

     

       37
       37
       +
       

     

       38
       38
       +
       This usually means there isn't enough whitespace between the documentation comment and the code element it's documenting. Always:

     

       39
       39
       +
       

     

       40
       40
       +
       1. Add blank lines between consecutive documentation comments

     

       41
       41
       +
       2. Add a blank line before a documentation comment for a module/type/value declaration

     

       42
       42
       +
       3. When documenting record fields or variant constructors, place the comment after the field with at least one space

     

       43
       43
       +
       

     

       44
       44
       +
       Example of correct documentation spacing:

     

       45
       45
       +
       

     

       46
       46
       +
       ```ocaml

     

       47
       47
       +
       (** Module documentation. *)

     

       48
       48
       +
       

     

       49
       49
       +
       (** Value documentation. *)

     

       50
       50
       +
       val some_value : int

     

       51
       51
       +
       

     

       52
       52
       +
       (** Type documentation. *)

     

       53
       53
       +
       type t = 

     

       54
       54
       +
         | First    (** First constructor *)

     

       55
       55
       +
         | Second   (** Second constructor *)

     

       56
       56
       +
       

     

       57
       57
       +
       (** Record documentation. *)

     

       58
       58
       +
       type record = {

     

       59
       59
       +
         field1 : int;   (** Field1 documentation *)

     

       60
       60
       +
         field2 : string (** Field2 documentation *)

     

       61
       61
       +
       }

     

       62
       62
       +
       ```

     

       63
       63
       +
       

     

       64
       64
       +
       If in doubt, add more whitespace lines than needed - you can always clean this up later with `dune build @fmt` to get ocamlformat to sort out the whitespace properly.

     

       65
       65
       +
       

     

       66
       66
       +
       When adding ocamldoc comments, use the information in the protocol specifications available to also add relevant explanations to the OCamldoc. Do not refer to the specification in the third-person, but directly include enough information in the OCamldoc for a reader to understand the protocol flow directly.

     

       67
       67
       +
       

     

       68
       68
       +
       # Module Structure Guidelines

     

       69
       69
       +
       

     

       70
       70
       +
       IMPORTANT: For all modules, use a nested module structure with a canonical `type t` inside each submodule. This approach ensures consistent type naming and logical grouping of related functionality.

     

       71
       71
       +
       

     

       72
       72
       +
       1. Top-level files should define their main types directly (e.g., `jmap_identity.mli` should define identity-related types at the top level).

     

       73
       73
       +
       

     

       74
       74
       +
       2. Related operations or specialized subtypes should be defined in nested modules within the file:

     

       75
       75
       +
          ```ocaml

     

       76
       76
       +
          module Create : sig

     

       77
       77
       +
            type t  (* NOT 'type create' or any other name *)

     

       78
       78
       +
            (* Functions operating on creation requests *)

     

       79
       79
       +
            

     

       80
       80
       +
            module Response : sig

     

       81
       81
       +
              type t

     

       82
       82
       +
              (* Functions for creation responses *)

     

       83
       83
       +
            end

     

       84
       84
       +
          end

     

       85
       85
       +
          ```

     

       86
       86
       +
       

     

       87
       87
       +
       3. Consistently use `type t` for the main type in each module and submodule.

     

       88
       88
       +
       

     

       89
       89
       +
       4. Functions operating on a type should be placed in the same module as the type.

     

       90
       90
       +
       

     

       91
       91
       +
       5. When a file is named after a concept (e.g., `jmap_identity.mli`), there's no need to have a matching nested module inside the file (e.g., `module Identity : sig...`), as the file itself represents that namespace.

     

       92
       92
       +
       

     

       93
       93
       +
       This structured approach promotes encapsulation, consistent type naming, and clearer organization of related functionality.

     

       94
       94
       +
       

     

       95
       95
       +
       # Software engineering

     

       96
       96
       +
       

     

       97
       97
       +
       We will go through a multi step process to build this library.

     

       98
       98
       +
       

     

       99
       99
       +
       1) we will generate OCaml interface files only, and no module implementations. The purpose here is to write and document the necessary type signatures. Once we generate these, we can check that they work with "dune build @check". Once that succeeds, we will build HTML documentation with "dune build @doc" in order to ensure the interfaces are reasonable.

     

       100
       100
       +
       

     

       101
       101
       +
       2) once these interface files exist, we will build a series of sample binaries that will attempt to implement the library for some sample usecases. This binary will not fully link, but it should type check. The only linking error that we get should be from the missing library implementation that we are currently buildign.

     

       102
       102
       +
       

     

       103
       103
       +
       3) we will calculate the dependency order for each module in our library, and work through an implementation of each one in increasing dependency order (that is, the module with the fewest dependencies should be handled first). For each module interface, we will generate a corresponding module implementation. We will also add test cases for this specific module, and update the dune files. Before proceeding to the next module, a build should be done to ensure the implementation builds and type checks as far as is possible.

     

       104
       104
       +

bin/dune

···

       1
       1
       +
       (executable

     

       2
       2
       +
        (public_name fcgi-server)

     

       3
       3
       +
        (name fcgi_server)

     

       4
       4
       +
        (libraries cmdliner eio eio_main fastcgi))

+79

bin/fcgi_server.ml

···

       1
       1
       +
       open Cmdliner

     

       2
       2
       +
       

     

       3
       3
       +
       (* Handler function that processes FastCGI requests *)

     

       4
       4
       +
       let handler ~stdout ~stderr request =

     

       5
       5
       +
         Eio.traceln "Processing request: %a" Fastcgi.Request.pp request;

     

       6
       6
       +
       

     

       7
       7
       +
         (* Get request parameters *)

     

       8
       8
       +
         let params = request.Fastcgi.Request.params in

     

       9
       9
       +
         let method_ = Fastcgi.Record.KV.find_opt "REQUEST_METHOD" params |> Option.value ~default:"GET" in

     

       10
       10
       +
         let uri = Fastcgi.Record.KV.find_opt "REQUEST_URI" params |> Option.value ~default:"/" in

     

       11
       11
       +
         let script_name = Fastcgi.Record.KV.find_opt "SCRIPT_NAME" params |> Option.value ~default:"" in

     

       12
       12
       +
       

     

       13
       13
       +
         (* Log request info *)

     

       14
       14
       +
         Eio.traceln "  Method: %s" method_;

     

       15
       15
       +
         Eio.traceln "  URI: %s" uri;

     

       16
       16
       +
         Eio.traceln "  Script: %s" script_name;

     

       17
       17
       +
       

     

       18
       18
       +
         (* Generate simple HTTP response *)

     

       19
       19
       +
         let response_body =

     

       20
       20
       +
           Printf.sprintf

     

       21
       21
       +
             "<!DOCTYPE html>\n\

     

       22
       22
       +
              <html>\n\

     

       23
       23
       +
              <head><title>FastCGI OCaml Server</title></head>\n\

     

       24
       24
       +
              <body>\n\

     

       25
       25
       +
              <h1>FastCGI OCaml Server</h1>\n\

     

       26
       26
       +
              <p>Request processed successfully!</p>\n\

     

       27
       27
       +
              <ul>\n\

     

       28
       28
       +
              <li>Method: %s</li>\n\

     

       29
       29
       +
              <li>URI: %s</li>\n\

     

       30
       30
       +
              <li>Script: %s</li>\n\

     

       31
       31
       +
              </ul>\n\

     

       32
       32
       +
              <h2>All Parameters:</h2>\n\

     

       33
       33
       +
              <pre>%s</pre>\n\

     

       34
       34
       +
              </body>\n\

     

       35
       35
       +
              </html>\n"

     

       36
       36
       +
             method_ uri script_name

     

       37
       37
       +
             (let params_seq = Fastcgi.Record.KV.to_seq params in

     

       38
       38
       +
              let params_list = List.of_seq params_seq in

     

       39
       39
       +
              String.concat "\n" (List.map (fun (k, v) -> Printf.sprintf "%s = %s" k v) params_list))

     

       40
       40
       +
         in

     

       41
       41
       +
       

     

       42
       42
       +
         (* Write HTTP response using FastCGI STDOUT records *)

     

       43
       43
       +
         let response_headers =

     

       44
       44
       +
           Printf.sprintf

     

       45
       45
       +
             "Status: 200 OK\r\n\

     

       46
       46
       +
              Content-Type: text/html; charset=utf-8\r\n\

     

       47
       47
       +
              Content-Length: %d\r\n\

     

       48
       48
       +
              \r\n"

     

       49
       49
       +
             (String.length response_body)

     

       50
       50
       +
         in

     

       51
       51
       +
         stdout response_headers;

     

       52
       52
       +
         stderr "stderr stuff";

     

       53
       53
       +
         stdout response_body

     

       54
       54
       +
       

     

       55
       55
       +
       let run port =

     

       56
       56
       +
         Eio_main.run @@ fun env ->

     

       57
       57
       +
         Eio.Switch.run @@ fun sw ->

     

       58
       58
       +
         let net = Eio.Stdenv.net env in

     

       59
       59
       +
         let addr = `Tcp (Eio.Net.Ipaddr.V4.loopback, port) in

     

       60
       60
       +
         let server_socket = Eio.Net.listen net ~backlog:10 ~reuse_addr:true ~sw addr in

     

       61
       61
       +
         Eio.traceln "FastCGI server listening on port %d" port;

     

       62
       62
       +
       

     

       63
       63
       +
         (* Run the FastCGI server *)

     

       64
       64
       +
         Fastcgi.run server_socket

     

       65
       65
       +
           ~on_error:(fun ex ->

     

       66
       66
       +
           Eio.traceln "Error: %s" (Printexc.to_string ex);

     

       67
       67
       +
           Eio.traceln "bt: %s" (Printexc.get_backtrace ()))

     

       68
       68
       +
           handler

     

       69
       69
       +
       

     

       70
       70
       +
       let port =

     

       71
       71
       +
         let doc = "Port to listen on" in

     

       72
       72
       +
         Arg.(value & opt int 9000 & info ["p"; "port"] ~docv:"PORT" ~doc)

     

       73
       73
       +
       

     

       74
       74
       +
       let cmd =

     

       75
       75
       +
         let doc = "FastCGI server" in

     

       76
       76
       +
         let info = Cmd.info "fcgi-server" ~doc in

     

       77
       77
       +
         Cmd.v info Term.(const run $ port)

     

       78
       78
       +
       

     

       79
       79
       +
       let () = exit (Cmd.eval cmd)

config/Caddyfile

···

       1
       1
       +
       {

     

       2
       2
       +
         debug

     

       3
       3
       +
       }

     

       4
       4
       +
       

     

       5
       5
       +
       localhost:80 {

     

       6
       6
       +
         php_fastcgi 127.0.0.1:9000

     

       7
       7
       +
       }

+27

dune-project

···

       1
       1
       +
       (lang dune 3.0)

     

       2
       2
       +
       

     

       3
       3
       +
       (name fastcgi)

     

       4
       4
       +
       

     

       5
       5
       +
       (generate_opam_files true)

     

       6
       6
       +
       

     

       7
       7
       +
       (source

     

       8
       8
       +
        (github ocaml/ocaml-fastcgi))

     

       9
       9
       +
       

     

       10
       10
       +
       (authors "OCaml FastCGI Library Authors")

     

       11
       11
       +
       

     

       12
       12
       +
       (maintainers "OCaml FastCGI Library Authors")

     

       13
       13
       +
       

     

       14
       14
       +
       (license ISC)

     

       15
       15
       +
       

     

       16
       16
       +
       (documentation https://ocaml.github.io/ocaml-fastcgi/)

     

       17
       17
       +
       

     

       18
       18
       +
       (package

     

       19
       19
       +
        (name fastcgi)

     

       20
       20
       +
        (depends 

     

       21
       21
       +
         ocaml 

     

       22
       22
       +
         dune

     

       23
       23
       +
         eio

     

       24
       24
       +
         cmdliner

     

       25
       25
       +
         eio_main)

     

       26
       26
       +
        (synopsis "FastCGI protocol implementation for OCaml using Eio")

     

       27
       27
       +
        (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."))

+34

fastcgi.opam

···

       1
       1
       +
       # This file is generated by dune, edit dune-project instead

     

       2
       2
       +
       opam-version: "2.0"

     

       3
       3
       +
       synopsis: "FastCGI protocol implementation for OCaml using Eio"

     

       4
       4
       +
       description:

     

       5
       5
       +
         "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."

     

       6
       6
       +
       maintainer: ["OCaml FastCGI Library Authors"]

     

       7
       7
       +
       authors: ["OCaml FastCGI Library Authors"]

     

       8
       8
       +
       license: "ISC"

     

       9
       9
       +
       homepage: "https://github.com/ocaml/ocaml-fastcgi"

     

       10
       10
       +
       doc: "https://ocaml.github.io/ocaml-fastcgi/"

     

       11
       11
       +
       bug-reports: "https://github.com/ocaml/ocaml-fastcgi/issues"

     

       12
       12
       +
       depends: [

     

       13
       13
       +
         "ocaml"

     

       14
       14
       +
         "dune" {>= "3.0"}

     

       15
       15
       +
         "eio"

     

       16
       16
       +
         "cmdliner"

     

       17
       17
       +
         "eio_main"

     

       18
       18
       +
         "odoc" {with-doc}

     

       19
       19
       +
       ]

     

       20
       20
       +
       build: [

     

       21
       21
       +
         ["dune" "subst"] {dev}

     

       22
       22
       +
         [

     

       23
       23
       +
           "dune"

     

       24
       24
       +
           "build"

     

       25
       25
       +
           "-p"

     

       26
       26
       +
           name

     

       27
       27
       +
           "-j"

     

       28
       28
       +
           jobs

     

       29
       29
       +
           "@install"

     

       30
       30
       +
           "@runtest" {with-test}

     

       31
       31
       +
           "@doc" {with-doc}

     

       32
       32
       +
         ]

     

       33
       33
       +
       ]

     

       34
       34
       +
       dev-repo: "git+https://github.com/ocaml/ocaml-fastcgi.git"

+10

lib/dune

···

       1
       1
       +
       (library

     

       2
       2
       +
        (public_name fastcgi)

     

       3
       3
       +
        (name fastcgi)

     

       4
       4
       +
        (libraries eio fmt)

     

       5
       5
       +
        (modules

     

       6
       6
       +
         fastcgi

     

       7
       7
       +
         fastcgi_record

     

       8
       8
       +
         fastcgi_request

     

       9
       9
       +
        )

     

       10
       10
       +
       )

+50

lib/fastcgi.ml

···

       1
       1
       +
       module Record = Fastcgi_record

     

       2
       2
       +
       

     

       3
       3
       +
       (** Request-level state machine and application interface *)

     

       4
       4
       +
       module Request = Fastcgi_request

     

       5
       5
       +
       

     

       6
       6
       +
       (* The lifetime of the handler is that the fiber should return when the

     

       7
       7
       +
          stdout and stderr flows are closed, or an abort request has been received *)

     

       8
       8
       +
       let handle req bw cancel fn =

     

       9
       9
       +
         let cancel () =

     

       10
       10
       +
           Eio.Promise.await cancel;

     

       11
       11
       +
           Eio.traceln "cancelled TODO"

     

       12
       12
       +
         in

     

       13
       13
       +
         let stdout buf = Request.write_stdout_records bw req.Request.request_id buf in

     

       14
       14
       +
         let stderr buf = Request.write_stderr_records bw req.Request.request_id buf in

     

       15
       15
       +
         let run () =

     

       16
       16
       +
           fn ~stdout ~stderr req;

     

       17
       17
       +
           Request.write_end_request bw req.Request.request_id 0 Request.Request_complete

     

       18
       18
       +
         in

     

       19
       19
       +
         Eio.Fiber.first run cancel

     

       20
       20
       +
       

     

       21
       21
       +
       let run ?max_connections ?additional_domains ?stop ~on_error socket handler =

     

       22
       22
       +
         Eio.Net.run_server socket ?max_connections ?additional_domains ?stop ~on_error

     

       23
       23
       +
           (fun socket peer_address ->

     

       24
       24
       +
             let ids = Hashtbl.create 7 in

     

       25
       25
       +
             Eio.Switch.run @@ fun sw ->

     

       26
       26
       +
             Eio.traceln  "%a: accept connection" Eio.Net.Sockaddr.pp peer_address;

     

       27
       27
       +
             let input = Eio.Buf_read.of_flow ~max_size:max_int socket in

     

       28
       28
       +
             Eio.Buf_write.with_flow socket @@ fun output ->

     

       29
       29
       +
             let cont = ref true in

     

       30
       30
       +
             try while !cont do

     

       31
       31
       +
               match Request.read_request input with

     

       32
       32
       +
               | Error msg ->

     

       33
       33
       +
                   Eio.traceln "%a: failed to read request: %s" Eio.Net.Sockaddr.pp peer_address msg;

     

       34
       34
       +
                   failwith "done";

     

       35
       35
       +
               | Ok req ->

     

       36
       36
       +
                   cont := req.Request.keep_conn;

     

       37
       37
       +
                   Eio.traceln "%a: %b read request %a" Eio.Net.Sockaddr.pp peer_address !cont Request.pp req;

     

       38
       38
       +
                   Eio.Fiber.fork ~sw (fun () ->

     

       39
       39
       +
                     Eio.Switch.run ~name:"req_handler" @@ fun sw ->

     

       40
       40
       +
                     let cancel, canceler = Eio.Promise.create () in

     

       41
       41
       +
                     Hashtbl.add ids req.Request.request_id canceler;

     

       42
       42
       +
                     Eio.Switch.on_release sw (fun () ->

     

       43
       43
       +
                       Hashtbl.remove ids req.Request.request_id

     

       44
       44
       +
                     );

     

       45
       45
       +
                     handle req output cancel handler;

     

       46
       46
       +
                   );

     

       47
       47
       +
             done

     

       48
       48
       +
             with Eio.Io (Eio.Net.E (Connection_reset _), _) ->

     

       49
       49
       +
               Eio.traceln "%a: connection reset" Eio.Net.Sockaddr.pp peer_address

     

       50
       50
       +
           )

+28

lib/fastcgi.mli

···

       1
       1
       +
       (** FastCGI protocol implementation for OCaml using Eio.

     

       2
       2
       +
       

     

       3
       3
       +
           This library provides a complete implementation of the FastCGI protocol

     

       4
       4
       +
           for building high-performance web applications in OCaml. *)

     

       5
       5
       +
       

     

       6
       6
       +
       

     

       7
       7
       +
       (** {1 Core Protocol Components} *)

     

       8
       8
       +
       

     

       9
       9
       +
       (** Record-level protocol handling *)

     

       10
       10
       +
       module Record = Fastcgi_record

     

       11
       11
       +
       

     

       12
       12
       +
       (** Request-level state machine and application interface *)

     

       13
       13
       +
       module Request = Fastcgi_request

     

       14
       14
       +
       

     

       15
       15
       +
       (** {1 High-level Request Processing} *)

     

       16
       16
       +
       

     

       17
       17
       +
       (** [handle_connection ~sw flow handler] handles complete FastCGI connection.

     

       18
       18
       +
           Reads requests from flow, processes them with handler, multiplexes responses.

     

       19
       19
       +
           Continues until connection is closed. *)

     

       20
       20
       +
       val run :

     

       21
       21
       +
                  ?max_connections:int ->

     

       22
       22
       +
                  ?additional_domains:[> Eio.Domain_manager.ty ] Eio.Resource.t *

     

       23
       23
       +
                                      int ->

     

       24
       24
       +
                  ?stop:'a Eio__core.Promise.t ->

     

       25
       25
       +
                  on_error:(exn -> unit) ->

     

       26
       26
       +
                  [> [> `Generic ] Eio.Net.listening_socket_ty ] Eio.Resource.t ->

     

       27
       27
       +
                  (stdout:(string -> unit) ->

     

       28
       28
       +
                   stderr:(string -> unit) -> Request.t -> unit) -> 'a

+305

lib/fastcgi_record.ml

···

       1
       1
       +
       

     

       2
       2
       +
       (** {1 Error Handling Helpers} *)

     

       3
       3
       +
       

     

       4
       4
       +
       (** Helper functions for consistent error handling *)

     

       5
       5
       +
       let invalid_version version = 

     

       6
       6
       +
         invalid_arg (Printf.sprintf "Unsupported FastCGI version: %d" version)

     

       7
       7
       +
       

     

       8
       8
       +
       let unknown_record_type n = 

     

       9
       9
       +
         invalid_arg (Printf.sprintf "Unknown FastCGI record type: %d" n)

     

       10
       10
       +
       

     

       11
       11
       +
       let buffer_underflow msg = 

     

       12
       12
       +
         failwith (Printf.sprintf "Unexpected end of buffer while %s" msg)

     

       13
       13
       +
       

     

       14
       14
       +
       let check_bounds buf pos len context =

     

       15
       15
       +
         if pos + len > String.length buf then

     

       16
       16
       +
           buffer_underflow context

     

       17
       17
       +
       

     

       18
       18
       +
       type version = int

     

       19
       19
       +
       

     

       20
       20
       +
       type record =

     

       21
       21
       +
         | Begin_request

     

       22
       22
       +
         | Abort_request

     

       23
       23
       +
         | End_request

     

       24
       24
       +
         | Params

     

       25
       25
       +
         | Stdin

     

       26
       26
       +
         | Stdout

     

       27
       27
       +
         | Stderr

     

       28
       28
       +
         | Data

     

       29
       29
       +
         | Get_values

     

       30
       30
       +
         | Get_values_result

     

       31
       31
       +
         | Unknown_type

     

       32
       32
       +
       

     

       33
       33
       +
       let record_to_int = function

     

       34
       34
       +
         | Begin_request -> 1

     

       35
       35
       +
         | Abort_request -> 2

     

       36
       36
       +
         | End_request -> 3

     

       37
       37
       +
         | Params -> 4

     

       38
       38
       +
         | Stdin -> 5

     

       39
       39
       +
         | Stdout -> 6

     

       40
       40
       +
         | Stderr -> 7

     

       41
       41
       +
         | Data -> 8

     

       42
       42
       +
         | Get_values -> 9

     

       43
       43
       +
         | Get_values_result -> 10

     

       44
       44
       +
         | Unknown_type -> 11

     

       45
       45
       +
       

     

       46
       46
       +
       let record_of_int = function

     

       47
       47
       +
         | 1 -> Begin_request

     

       48
       48
       +
         | 2 -> Abort_request

     

       49
       49
       +
         | 3 -> End_request

     

       50
       50
       +
         | 4 -> Params

     

       51
       51
       +
         | 5 -> Stdin

     

       52
       52
       +
         | 6 -> Stdout

     

       53
       53
       +
         | 7 -> Stderr

     

       54
       54
       +
         | 8 -> Data

     

       55
       55
       +
         | 9 -> Get_values

     

       56
       56
       +
         | 10 -> Get_values_result

     

       57
       57
       +
         | 11 -> Unknown_type

     

       58
       58
       +
         | n -> unknown_record_type n

     

       59
       59
       +
       

     

       60
       60
       +
       let pp_record ppf = function

     

       61
       61
       +
         | Begin_request -> Format.pp_print_string ppf "Begin_request"

     

       62
       62
       +
         | Abort_request -> Format.pp_print_string ppf "Abort_request"

     

       63
       63
       +
         | End_request -> Format.pp_print_string ppf "End_request"

     

       64
       64
       +
         | Params -> Format.pp_print_string ppf "Params"

     

       65
       65
       +
         | Stdin -> Format.pp_print_string ppf "Stdin"

     

       66
       66
       +
         | Stdout -> Format.pp_print_string ppf "Stdout"

     

       67
       67
       +
         | Stderr -> Format.pp_print_string ppf "Stderr"

     

       68
       68
       +
         | Data -> Format.pp_print_string ppf "Data"

     

       69
       69
       +
         | Get_values -> Format.pp_print_string ppf "Get_values"

     

       70
       70
       +
         | Get_values_result -> Format.pp_print_string ppf "Get_values_result"

     

       71
       71
       +
         | Unknown_type -> Format.pp_print_string ppf "Unknown_type"

     

       72
       72
       +
       

     

       73
       73
       +
       type request_id = int

     

       74
       74
       +
       

     

       75
       75
       +
       type t = {

     

       76
       76
       +
         version : version;

     

       77
       77
       +
         record_type : record;

     

       78
       78
       +
         request_id : request_id;

     

       79
       79
       +
         content : string;

     

       80
       80
       +
         offset : int;

     

       81
       81
       +
         length : int;

     

       82
       82
       +
       }

     

       83
       83
       +
       

     

       84
       84
       +
       let pp ?(max_content_len=100) ppf record =

     

       85
       85
       +
         let actual_content = String.sub record.content record.offset record.length in

     

       86
       86
       +
         let truncated_content = 

     

       87
       87
       +
           let len = String.length actual_content in

     

       88
       88
       +
           if len <= max_content_len then actual_content

     

       89
       89
       +
           else String.sub actual_content 0 max_content_len ^ "..." ^ Printf.sprintf " (%d more bytes)" (len - max_content_len)

     

       90
       90
       +
         in

     

       91
       91
       +
         Format.fprintf ppf

     

       92
       92
       +
           "@[<2>{ version = %d;@ record_type = %a;@ request_id = %d;@ content = %S;@ offset = %d;@ length = %d }@]"

     

       93
       93
       +
           record.version

     

       94
       94
       +
           pp_record record.record_type

     

       95
       95
       +
           record.request_id

     

       96
       96
       +
           truncated_content

     

       97
       97
       +
           record.offset

     

       98
       98
       +
           record.length

     

       99
       99
       +
       

     

       100
       100
       +
       (* FastCGI constants *)

     

       101
       101
       +
       let fcgi_version_1 = 1

     

       102
       102
       +
       let fcgi_header_len = 8

     

       103
       103
       +
       

     

       104
       104
       +
       let read buf_read =

     

       105
       105
       +
         Printf.eprintf "[DEBUG] Fastcgi_record.read: Starting to read record\n%!";

     

       106
       106
       +
         (* Read the 8-byte header *)

     

       107
       107
       +
         Printf.eprintf "[DEBUG] Fastcgi_record.read: Reading %d-byte header\n%!" fcgi_header_len;

     

       108
       108
       +
         let header = Eio.Buf_read.take fcgi_header_len buf_read in

     

       109
       109
       +
         

     

       110
       110
       +
         (* Parse header fields *)

     

       111
       111
       +
         let version = Char.code header.[0] in

     

       112
       112
       +
         let record_type_int = Char.code header.[1] in

     

       113
       113
       +
         let request_id = (Char.code header.[2] lsl 8) lor (Char.code header.[3]) in

     

       114
       114
       +
         let content_length = (Char.code header.[4] lsl 8) lor (Char.code header.[5]) in

     

       115
       115
       +
         let padding_length = Char.code header.[6] in

     

       116
       116
       +
         let _reserved = Char.code header.[7] in

     

       117
       117
       +
         

     

       118
       118
       +
         Printf.eprintf "[DEBUG] Fastcgi_record.read: Header parsed - version=%d, type=%d, id=%d, content_len=%d, padding=%d\n%!"

     

       119
       119
       +
           version record_type_int request_id content_length padding_length;

     

       120
       120
       +
         

     

       121
       121
       +
         (* Validate version *)

     

       122
       122
       +
         if version <> fcgi_version_1 then invalid_version version;

     

       123
       123
       +
         

     

       124
       124
       +
         (* Convert record type *)

     

       125
       125
       +
         let record_type = record_of_int record_type_int in

     

       126
       126
       +
         Printf.eprintf "[DEBUG] Fastcgi_record.read: Record type = %s\n%!" 

     

       127
       127
       +
           (Format.asprintf "%a" pp_record record_type);

     

       128
       128
       +
         

     

       129
       129
       +
         (* Read content *)

     

       130
       130
       +
         let content = 

     

       131
       131
       +
           if content_length = 0 then (

     

       132
       132
       +
             Printf.eprintf "[DEBUG] Fastcgi_record.read: No content to read (length=0)\n%!";

     

       133
       133
       +
             ""

     

       134
       134
       +
           ) else (

     

       135
       135
       +
             Printf.eprintf "[DEBUG] Fastcgi_record.read: Reading %d bytes of content\n%!" content_length;

     

       136
       136
       +
             let c = Eio.Buf_read.take content_length buf_read in

     

       137
       137
       +
             Printf.eprintf "[DEBUG] Fastcgi_record.read: Successfully read %d bytes\n%!" (String.length c);

     

       138
       138
       +
             c

     

       139
       139
       +
           )

     

       140
       140
       +
         in

     

       141
       141
       +
         

     

       142
       142
       +
         (* Skip padding *)

     

       143
       143
       +
         if padding_length > 0 then (

     

       144
       144
       +
           Printf.eprintf "[DEBUG] Fastcgi_record.read: Skipping %d bytes of padding\n%!" padding_length;

     

       145
       145
       +
           ignore (Eio.Buf_read.take padding_length buf_read)

     

       146
       146
       +
         );

     

       147
       147
       +
         

     

       148
       148
       +
         let record = { version; record_type; request_id; content; offset = 0; length = String.length content } in

     

       149
       149
       +
         Printf.eprintf "[DEBUG] Fastcgi_record.read: Complete record = %s\n%!" 

     

       150
       150
       +
           (Format.asprintf "%a" (pp ~max_content_len:50) record);

     

       151
       151
       +
         record

     

       152
       152
       +
       

     

       153
       153
       +
       let write buf_write record =

     

       154
       154
       +
         let total_content_length = String.length record.content in

     

       155
       155
       +
         let content_offset = record.offset in

     

       156
       156
       +
         let content_length = record.length in

     

       157
       157
       +
         

     

       158
       158
       +
         (* Validate bounds *)

     

       159
       159
       +
         if content_offset < 0 || content_offset > total_content_length then

     

       160
       160
       +
           invalid_arg "Fastcgi_record.write: offset out of bounds";

     

       161
       161
       +
         if content_length < 0 || content_offset + content_length > total_content_length then

     

       162
       162
       +
           invalid_arg "Fastcgi_record.write: length out of bounds";

     

       163
       163
       +
         

     

       164
       164
       +
         (* Calculate padding for 8-byte alignment *)

     

       165
       165
       +
         let padding_length = (8 - (content_length land 7)) land 7 in

     

       166
       166
       +
         

     

       167
       167
       +
         (* Create and write header *)

     

       168
       168
       +
         let header = Bytes.create fcgi_header_len in

     

       169
       169
       +
         Bytes.set_uint8 header 0 record.version;

     

       170
       170
       +
         Bytes.set_uint8 header 1 (record_to_int record.record_type);

     

       171
       171
       +
         Bytes.set_uint16_be header 2 record.request_id;

     

       172
       172
       +
         Bytes.set_uint16_be header 4 content_length;

     

       173
       173
       +
         Bytes.set_uint8 header 6 padding_length;

     

       174
       174
       +
         Bytes.set_uint8 header 7 0; (* reserved *)

     

       175
       175
       +
         

     

       176
       176
       +
         Eio.Buf_write.string buf_write (Bytes.to_string header);

     

       177
       177
       +
         

     

       178
       178
       +
         (* Write content with offset and length *)

     

       179
       179
       +
         if content_length > 0 then

     

       180
       180
       +
           Eio.Buf_write.string buf_write record.content ~off:content_offset ~len:content_length;

     

       181
       181
       +
         

     

       182
       182
       +
         (* Write padding *)

     

       183
       183
       +
         if padding_length > 0 then

     

       184
       184
       +
           Eio.Buf_write.string buf_write (String.make padding_length '\000')

     

       185
       185
       +
       

     

       186
       186
       +
       let create ?(version=1) ~record ~request_id ~content ?(offset=0) ?length () =

     

       187
       187
       +
         let content_length = match length with

     

       188
       188
       +
           | None -> String.length content - offset

     

       189
       189
       +
           | Some l -> l

     

       190
       190
       +
         in

     

       191
       191
       +
         { version; record_type = record; request_id; content; offset; length = content_length }

     

       192
       192
       +
       

     

       193
       193
       +
       module KV = struct

     

       194
       194
       +
         type t = (string * string) list

     

       195
       195
       +
       

     

       196
       196
       +
         let empty = []

     

       197
       197
       +
       

     

       198
       198
       +
         let add key value kvs = (key, value) :: kvs

     

       199
       199
       +
       

     

       200
       200
       +
         let remove key kvs = List.filter (fun (k, _) -> k <> key) kvs

     

       201
       201
       +
         

     

       202
       202
       +
         let cardinal kvs = List.length kvs

     

       203
       203
       +
       

     

       204
       204
       +
         let find key kvs = 

     

       205
       205
       +
           try List.assoc key kvs

     

       206
       206
       +
           with Not_found -> raise Not_found

     

       207
       207
       +
       

     

       208
       208
       +
         let find_opt key kvs = 

     

       209
       209
       +
           try Some (List.assoc key kvs)

     

       210
       210
       +
           with Not_found -> None

     

       211
       211
       +
       

     

       212
       212
       +
         let to_seq kvs = List.to_seq kvs

     

       213
       213
       +
       

     

       214
       214
       +
         let of_seq seq = List.of_seq seq

     

       215
       215
       +
       

     

       216
       216
       +
         (** Helper functions for length encoding/decoding *)

     

       217
       217
       +
         let is_long_length first_byte = first_byte land 0x80 <> 0

     

       218
       218
       +
         

     

       219
       219
       +
         let decode_short_length first_byte = first_byte

     

       220
       220
       +
         

     

       221
       221
       +
         let decode_long_length buf pos =

     

       222
       222
       +
           check_bounds buf pos 4 "reading 4-byte length";

     

       223
       223
       +
           let first_byte = Char.code buf.[pos] in

     

       224
       224
       +
           ((first_byte land 0x7f) lsl 24) lor

     

       225
       225
       +
           ((Char.code buf.[pos + 1]) lsl 16) lor

     

       226
       226
       +
           ((Char.code buf.[pos + 2]) lsl 8) lor

     

       227
       227
       +
           (Char.code buf.[pos + 3])

     

       228
       228
       +
       

     

       229
       229
       +
         let encode_length len =

     

       230
       230
       +
           if len <= 127 then

     

       231
       231
       +
             String.make 1 (Char.chr len)

     

       232
       232
       +
           else

     

       233
       233
       +
             let b = Bytes.create 4 in

     

       234
       234
       +
             Bytes.set_int32_be b 0 (Int32.logor (Int32.of_int len) 0x80000000l);

     

       235
       235
       +
             Bytes.to_string b

     

       236
       236
       +
       

     

       237
       237
       +
         let decode_length buf pos =

     

       238
       238
       +
           check_bounds buf pos 1 "reading length";

     

       239
       239
       +
           let first_byte = Char.code buf.[pos] in

     

       240
       240
       +
           if is_long_length first_byte then

     

       241
       241
       +
             (* Four byte length *)

     

       242
       242
       +
             let len = decode_long_length buf pos in

     

       243
       243
       +
             (len, pos + 4)

     

       244
       244
       +
           else

     

       245
       245
       +
             (* Single byte length *)

     

       246
       246
       +
             (decode_short_length first_byte, pos + 1)

     

       247
       247
       +
       

     

       248
       248
       +
         let encode kvs =

     

       249
       249
       +
           let buf = Buffer.create 256 in

     

       250
       250
       +
           List.iter (fun (key, value) ->

     

       251
       251
       +
             let key_len = String.length key in

     

       252
       252
       +
             let value_len = String.length value in

     

       253
       253
       +
             Buffer.add_string buf (encode_length key_len);

     

       254
       254
       +
             Buffer.add_string buf (encode_length value_len);

     

       255
       255
       +
             Buffer.add_string buf key;

     

       256
       256
       +
             Buffer.add_string buf value

     

       257
       257
       +
           ) kvs;

     

       258
       258
       +
           Buffer.contents buf

     

       259
       259
       +
       

     

       260
       260
       +
         (** Extract key-value pair from buffer at given position *)

     

       261
       261
       +
         let extract_kv_pair content pos name_len value_len =

     

       262
       262
       +
           check_bounds content pos (name_len + value_len) "reading key-value data";

     

       263
       263
       +
           let name = String.sub content pos name_len in

     

       264
       264
       +
           let value = String.sub content (pos + name_len) value_len in

     

       265
       265
       +
           (name, value)

     

       266
       266
       +
       

     

       267
       267
       +
         let decode content =

     

       268
       268
       +
           let len = String.length content in

     

       269
       269
       +
           let rec loop pos acc =

     

       270
       270
       +
             if pos >= len then

     

       271
       271
       +
               List.rev acc

     

       272
       272
       +
             else

     

       273
       273
       +
               (* Read name length *)

     

       274
       274
       +
               let name_len, pos = decode_length content pos in

     

       275
       275
       +
               (* Read value length *)

     

       276
       276
       +
               let value_len, pos = decode_length content pos in

     

       277
       277
       +
               

     

       278
       278
       +
               (* Extract name and value *)

     

       279
       279
       +
               let name, value = extract_kv_pair content pos name_len value_len in

     

       280
       280
       +
               

     

       281
       281
       +
               loop (pos + name_len + value_len) ((name, value) :: acc)

     

       282
       282
       +
           in

     

       283
       283
       +
           loop 0 []

     

       284
       284
       +
       

     

       285
       285
       +
         let read buf_read =

     

       286
       286
       +
           (* For reading from a stream, we need to determine how much data to read.

     

       287
       287
       +
              Since we're in a record context, we should read all available data

     

       288
       288
       +
              until we hit the end of the record content. *)

     

       289
       289
       +
           let content = Eio.Buf_read.take_all buf_read in

     

       290
       290
       +
           decode content

     

       291
       291
       +
       

     

       292
       292
       +
         let write buf_write kvs =

     

       293
       293
       +
           let encoded = encode kvs in

     

       294
       294
       +
           Eio.Buf_write.string buf_write encoded

     

       295
       295
       +
       

     

       296
       296
       +
         let pp ppf kvs =

     

       297
       297
       +
           Format.fprintf ppf "@[<2>[@[";

     

       298
       298
       +
           let first = ref true in

     

       299
       299
       +
           List.iter (fun (key, value) ->

     

       300
       300
       +
             if not !first then Format.fprintf ppf ";@ ";

     

       301
       301
       +
             first := false;

     

       302
       302
       +
             Format.fprintf ppf "(%S, %S)" key value

     

       303
       303
       +
           ) kvs;

     

       304
       304
       +
           Format.fprintf ppf "@]]@]"

     

       305
       305
       +
       end

+131

lib/fastcgi_record.mli

···

       1
       1
       +
       (** FastCGI record handling for parsing and creating protocol messages.

     

       2
       2
       +
       

     

       3
       3
       +
           This module provides the core functionality for handling FastCGI records,

     

       4
       4
       +
           which are the fundamental units of communication in the FastCGI protocol.

     

       5
       5
       +
           Records multiplex multiple requests over a single connection and provide

     

       6
       6
       +
           independent data streams within each request. *)

     

       7
       7
       +
       

     

       8
       8
       +
       (** {1 Record Structure} *)

     

       9
       9
       +
       

     

       10
       10
       +
       (** FastCGI protocol version *)

     

       11
       11
       +
       type version = int

     

       12
       12
       +
       

     

       13
       13
       +
       (** Record types define the purpose and interpretation of record content *)

     

       14
       14
       +
       type record =

     

       15
       15
       +
         | Begin_request     (** Start a new FastCGI request *)

     

       16
       16
       +
         | Abort_request     (** Abort an existing request *)

     

       17
       17
       +
         | End_request       (** Terminate a request *)

     

       18
       18
       +
         | Params            (** Name-value pairs (environment variables) *)

     

       19
       19
       +
         | Stdin             (** Standard input data stream *)

     

       20
       20
       +
         | Stdout            (** Standard output data stream *)

     

       21
       21
       +
         | Stderr            (** Standard error data stream *)

     

       22
       22
       +
         | Data              (** Additional data stream for Filter role *)

     

       23
       23
       +
         | Get_values        (** Query application capabilities *)

     

       24
       24
       +
         | Get_values_result (** Response to capability query *)

     

       25
       25
       +
         | Unknown_type      (** Unknown record type response *)

     

       26
       26
       +
       

     

       27
       27
       +
       (** [record_type_to_int rt] converts record type to its protocol integer value *)

     

       28
       28
       +
       val record_to_int : record -> int

     

       29
       29
       +
       

     

       30
       30
       +
       (** [record_type_of_int i] converts protocol integer to record type.

     

       31
       31
       +
           Raises Invalid_argument for unknown values. *)

     

       32
       32
       +
       val record_of_int : int -> record

     

       33
       33
       +
       

     

       34
       34
       +
       (** [pp_record ppf rt] pretty-prints a record type *)

     

       35
       35
       +
       val pp_record : Format.formatter -> record -> unit

     

       36
       36
       +
       

     

       37
       37
       +
       (** Request identifier for multiplexing multiple requests over one connection.

     

       38
       38
       +
           Request ID 0 is reserved for management records. *)

     

       39
       39
       +
       type request_id = int

     

       40
       40
       +
       

     

       41
       41
       +
       (** A complete FastCGI record containing header and content.

     

       42
       42
       +
           Records consist of an 8-byte fixed header followed by variable-length

     

       43
       43
       +
           content and optional padding for alignment. *)

     

       44
       44
       +
       type t = {

     

       45
       45
       +
         version : version;           (** Protocol version (always 1) *)

     

       46
       46
       +
         record_type : record;        (** Type of this record *)

     

       47
       47
       +
         request_id : request_id;     (** Request identifier *)

     

       48
       48
       +
         content : string;            (** Record content data *)

     

       49
       49
       +
         offset : int;                (** Offset within content string (default: 0) *)

     

       50
       50
       +
         length : int;                (** Length to use from content (default: String.length content) *)

     

       51
       51
       +
       }

     

       52
       52
       +
       

     

       53
       53
       +
       (** [pp ?max_content_len ppf record] pretty-prints a FastCGI record.

     

       54
       54
       +
           [max_content_len] limits the displayed content length (default: 100 bytes) *)

     

       55
       55
       +
       val pp : ?max_content_len:int -> Format.formatter -> t -> unit

     

       56
       56
       +
       

     

       57
       57
       +
       (** {1 Record Operations} *)

     

       58
       58
       +
       

     

       59
       59
       +
       (** [read buf_read] reads a complete FastCGI record from the input buffer.

     

       60
       60
       +
           Returns the parsed record or raises an exception if the record is malformed

     

       61
       61
       +
           or if there's insufficient data. The padding is automatically handled and

     

       62
       62
       +
           discarded during parsing. *)

     

       63
       63
       +
       val read : Eio.Buf_read.t -> t

     

       64
       64
       +
       

     

       65
       65
       +
       (** [write buf_write record] writes a FastCGI record to the output buffer.

     

       66
       66
       +
           The record header is automatically constructed from the record fields,

     

       67
       67
       +
           and appropriate padding is added to align the record on 8-byte boundaries

     

       68
       68
       +
           for optimal performance. Uses the record's offset and length fields to

     

       69
       69
       +
           determine which portion of the content to write. *)

     

       70
       70
       +
       val write : Eio.Buf_write.t -> t -> unit

     

       71
       71
       +
       

     

       72
       72
       +
       (** [create ?version ~record ~request_id ~content ?offset ?length] creates a new record

     

       73
       73
       +
           with the specified parameters. Version defaults to 1 (the only supported version).

     

       74
       74
       +
           If offset and length are not provided, the entire content string is used. *)

     

       75
       75
       +
       val create : ?version:version -> record:record -> 

     

       76
       76
       +
                    request_id:request_id -> content:string -> 

     

       77
       77
       +
                    ?offset:int -> ?length:int -> unit -> t

     

       78
       78
       +
       

     

       79
       79
       +
       (** {1 Key-Value Pairs} *)

     

       80
       80
       +
       

     

       81
       81
       +
       (** Key-value pairs are used to transmit environment variables and other

     

       82
       82
       +
           key-value data in FCGI_PARAMS and other record types. The FastCGI protocol

     

       83
       83
       +
           uses a specific encoding where lengths are variable-width (1 or 4 bytes). *)

     

       84
       84
       +
       

     

       85
       85
       +
       module KV : sig

     

       86
       86
       +
         (** Type for key-value pair collections *)

     

       87
       87
       +
         type t

     

       88
       88
       +
       

     

       89
       89
       +
         (** [empty] creates an empty key-value pair collection *)

     

       90
       90
       +
         val empty : t

     

       91
       91
       +
       

     

       92
       92
       +
         (** [add name value pairs] adds a key-value pair to the collection *)

     

       93
       93
       +
         val add : string -> string -> t -> t

     

       94
       94
       +
       

     

       95
       95
       +
         (** [remove name pairs] removes all pairs with the given key *)

     

       96
       96
       +
         val remove : string -> t -> t

     

       97
       97
       +
       

     

       98
       98
       +
         (** [find name pairs] returns the value associated with the given key.

     

       99
       99
       +
             Raises Not_found if the key is not present. *)

     

       100
       100
       +
         val find : string -> t -> string

     

       101
       101
       +
       

     

       102
       102
       +
         (** [find_opt name pairs] returns Some value or None if not found *)

     

       103
       103
       +
         val find_opt : string -> t -> string option

     

       104
       104
       +
       

     

       105
       105
       +
         (** [to_seq pairs] converts to a sequence of (key, value) tuples *)

     

       106
       106
       +
         val to_seq : t -> (string * string) Seq.t

     

       107
       107
       +
       

     

       108
       108
       +
         (** [of_seq pairs] creates from a sequence of (key, value) tuples *)

     

       109
       109
       +
         val of_seq : (string * string) Seq.t -> t

     

       110
       110
       +
         

     

       111
       111
       +
         (** [cardinal pairs] returns the number of key-value pairs *)

     

       112
       112
       +
         val cardinal : t -> int

     

       113
       113
       +
       

     

       114
       114
       +
         (** [read buf_read] reads key-value pairs from a buffer.

     

       115
       115
       +
             Handles the FastCGI variable-length encoding where lengths ≤ 127 bytes

     

       116
       116
       +
             use 1 byte, longer lengths use 4 bytes with the high bit set. *)

     

       117
       117
       +
         val read : Eio.Buf_read.t -> t

     

       118
       118
       +
       

     

       119
       119
       +
         (** [write buf_write pairs] writes key-value pairs to a buffer using

     

       120
       120
       +
             the FastCGI encoding format *)

     

       121
       121
       +
         val write : Eio.Buf_write.t -> t -> unit

     

       122
       122
       +
       

     

       123
       123
       +
         (** [encode pairs] returns the encoded byte string representation *)

     

       124
       124
       +
         val encode : t -> string

     

       125
       125
       +
       

     

       126
       126
       +
         (** [decode content] parses encoded key-value pairs from a string *)

     

       127
       127
       +
         val decode : string -> t

     

       128
       128
       +
       

     

       129
       129
       +
         (** [pp ppf pairs] pretty-prints key-value pairs *)

     

       130
       130
       +
         val pp : Format.formatter -> t -> unit

     

       131
       131
       +
       end

+279

lib/fastcgi_request.ml

···

       1
       1
       +
       open Fastcgi_record

     

       2
       2
       +
       

     

       3
       3
       +
       (** {1 Request Roles} *)

     

       4
       4
       +
       

     

       5
       5
       +
       type role =

     

       6
       6
       +
         | Responder

     

       7
       7
       +
         | Authorizer

     

       8
       8
       +
         | Filter

     

       9
       9
       +
       

     

       10
       10
       +
       let pp_role ppf = function

     

       11
       11
       +
         | Responder -> Format.pp_print_string ppf "Responder"

     

       12
       12
       +
         | Authorizer -> Format.pp_print_string ppf "Authorizer"

     

       13
       13
       +
         | Filter -> Format.pp_print_string ppf "Filter"

     

       14
       14
       +
       

     

       15
       15
       +
       let role_of_begin_request record =

     

       16
       16
       +
         if record.record_type <> Begin_request then

     

       17
       17
       +
           Error "Expected BEGIN_REQUEST record"

     

       18
       18
       +
         else if String.length record.content <> 8 then

     

       19
       19
       +
           Error "Invalid BEGIN_REQUEST content length"

     

       20
       20
       +
         else

     

       21
       21
       +
           let content = record.content in

     

       22
       22
       +
           let role_int = (Char.code content.[0] lsl 8) lor (Char.code content.[1]) in

     

       23
       23
       +
           match role_int with

     

       24
       24
       +
           | 1 -> Ok Responder

     

       25
       25
       +
           | 2 -> Ok Authorizer

     

       26
       26
       +
           | 3 -> Ok Filter

     

       27
       27
       +
           | n -> Error (Printf.sprintf "Unknown FastCGI role: %d" n)

     

       28
       28
       +
       

     

       29
       29
       +
       (** {1 Request Context} *)

     

       30
       30
       +
       

     

       31
       31
       +
       type t = {

     

       32
       32
       +
         request_id : request_id;

     

       33
       33
       +
         role : role;

     

       34
       34
       +
         keep_conn : bool;

     

       35
       35
       +
         params : KV.t;

     

       36
       36
       +
         stdin_data : string;

     

       37
       37
       +
         data_stream : string option;

     

       38
       38
       +
       }

     

       39
       39
       +
       

     

       40
       40
       +
       let pp ppf request =

     

       41
       41
       +
         let data_str = match request.data_stream with

     

       42
       42
       +
           | None -> "None"

     

       43
       43
       +
           | Some d -> Printf.sprintf "Some(%d bytes)" (String.length d)

     

       44
       44
       +
         in

     

       45
       45
       +
         Format.fprintf ppf

     

       46
       46
       +
           "@[<2>{ request_id = %d;@ role = %a;@ keep_conn = %b;@ params = %a;@ stdin = %d bytes;@ data = %s }@]"

     

       47
       47
       +
           request.request_id

     

       48
       48
       +
           pp_role request.role

     

       49
       49
       +
           request.keep_conn

     

       50
       50
       +
           (KV.pp) request.params

     

       51
       51
       +
           (String.length request.stdin_data)

     

       52
       52
       +
           data_str

     

       53
       53
       +
       

     

       54
       54
       +
       let create record =

     

       55
       55
       +
         match role_of_begin_request record with

     

       56
       56
       +
         | Error _ as e -> e

     

       57
       57
       +
         | Ok role ->

     

       58
       58
       +
             if String.length record.content <> 8 then

     

       59
       59
       +
               Error "Invalid BEGIN_REQUEST content length"

     

       60
       60
       +
             else

     

       61
       61
       +
               let flags_int = Char.code record.content.[2] in

     

       62
       62
       +
               let keep_conn = (flags_int land 1) <> 0 in

     

       63
       63
       +
               Ok {

     

       64
       64
       +
                 request_id = record.request_id;

     

       65
       65
       +
                 role;

     

       66
       66
       +
                 keep_conn;

     

       67
       67
       +
                 params = KV.empty;

     

       68
       68
       +
                 stdin_data = "";

     

       69
       69
       +
                 data_stream = if role = Filter then Some "" else None;

     

       70
       70
       +
               }

     

       71
       71
       +
       

     

       72
       72
       +
       

     

       73
       73
       +
       (** {1 Stream Processing} *)

     

       74
       74
       +
       

     

       75
       75
       +
       (** Helper functions for result binding to simplify nested pattern matching *)

     

       76
       76
       +
       let ( let* ) = Result.bind

     

       77
       77
       +
       

     

       78
       78
       +
       let is_stream_terminator record =

     

       79
       79
       +
         String.length record.content = 0

     

       80
       80
       +
       

     

       81
       81
       +
       

     

       82
       82
       +
       let read_params buf_read =

     

       83
       83
       +
         Printf.eprintf "[DEBUG] read_params_from_flow: Starting\n%!";

     

       84
       84
       +
         let params = ref KV.empty in

     

       85
       85
       +
         let rec loop () =

     

       86
       86
       +
           try

     

       87
       87
       +
             Printf.eprintf "[DEBUG] read_params_from_flow: Reading next PARAMS record\n%!";

     

       88
       88
       +
             let record = Fastcgi_record.read buf_read in

     

       89
       89
       +
             Printf.eprintf "[DEBUG] read_params_from_flow: Got record type=%s, content_length=%d\n%!"

     

       90
       90
       +
               (Format.asprintf "%a" pp_record record.record_type)

     

       91
       91
       +
               (String.length record.content);

     

       92
       92
       +
             if record.record_type <> Params then

     

       93
       93
       +
               Error (Printf.sprintf "Expected PARAMS record, got %s"

     

       94
       94
       +
                             (Format.asprintf "%a" pp_record record.record_type))

     

       95
       95
       +
             else if is_stream_terminator record then (

     

       96
       96
       +
               Printf.eprintf "[DEBUG] read_params_from_flow: Got stream terminator, returning %d params\n%!"

     

       97
       97
       +
                 (Fastcgi_record.KV.cardinal !params);

     

       98
       98
       +
               Ok !params

     

       99
       99
       +
             ) else (

     

       100
       100
       +
               let record_params = KV.decode record.content in

     

       101
       101
       +
               Printf.eprintf "[DEBUG] read_params_from_flow: Decoded %d params from record\n%!"

     

       102
       102
       +
                 (Fastcgi_record.KV.cardinal record_params);

     

       103
       103
       +
               params := KV.to_seq record_params

     

       104
       104
       +
                         |> Seq.fold_left (fun acc (k, v) -> KV.add k v acc) !params;

     

       105
       105
       +
               loop ()

     

       106
       106
       +
             )

     

       107
       107
       +
           with

     

       108
       108
       +
           | End_of_file -> 

     

       109
       109
       +
               Printf.eprintf "[DEBUG] read_params_from_flow: Hit End_of_file\n%!";

     

       110
       110
       +
               Error "Unexpected end of stream while reading PARAMS"

     

       111
       111
       +
           | exn -> 

     

       112
       112
       +
               Printf.eprintf "[DEBUG] read_params_from_flow: Exception: %s\n%!" (Printexc.to_string exn);

     

       113
       113
       +
               Error (Printf.sprintf "Error reading PARAMS: %s" (Printexc.to_string exn))

     

       114
       114
       +
         in

     

       115
       115
       +
         loop ()

     

       116
       116
       +
       

     

       117
       117
       +
       let read_stdin buf_read =

     

       118
       118
       +
         Printf.eprintf "[DEBUG] read_stdin_from_flow: Starting\n%!";

     

       119
       119
       +
         let data = Buffer.create 1024 in

     

       120
       120
       +
         let rec loop () =

     

       121
       121
       +
           try

     

       122
       122
       +
             Printf.eprintf "[DEBUG] read_stdin_from_flow: Reading next STDIN record\n%!";

     

       123
       123
       +
             let record = Fastcgi_record.read buf_read in

     

       124
       124
       +
             Printf.eprintf "[DEBUG] read_stdin_from_flow: Got record type=%s, content_length=%d\n%!"

     

       125
       125
       +
               (Format.asprintf "%a" pp_record record.record_type)

     

       126
       126
       +
               (String.length record.content);

     

       127
       127
       +
             if record.record_type <> Stdin then

     

       128
       128
       +
               Error (Printf.sprintf "Expected STDIN record, got %s"

     

       129
       129
       +
                             (Format.asprintf "%a" pp_record record.record_type))

     

       130
       130
       +
             else if is_stream_terminator record then (

     

       131
       131
       +
               Printf.eprintf "[DEBUG] read_stdin_from_flow: Got stream terminator, total stdin=%d bytes\n%!"

     

       132
       132
       +
                 (Buffer.length data);

     

       133
       133
       +
               Ok (Buffer.contents data)

     

       134
       134
       +
             ) else (

     

       135
       135
       +
               Buffer.add_string data record.content;

     

       136
       136
       +
               Printf.eprintf "[DEBUG] read_stdin_from_flow: Added %d bytes, total now %d\n%!"

     

       137
       137
       +
                 (String.length record.content) (Buffer.length data);

     

       138
       138
       +
               loop ()

     

       139
       139
       +
             )

     

       140
       140
       +
           with

     

       141
       141
       +
           | End_of_file -> 

     

       142
       142
       +
               Printf.eprintf "[DEBUG] read_stdin_from_flow: Hit End_of_file\n%!";

     

       143
       143
       +
               Error "Unexpected end of stream while reading STDIN"

     

       144
       144
       +
           | exn -> 

     

       145
       145
       +
               Printf.eprintf "[DEBUG] read_stdin_from_flow: Exception: %s\n%!" (Printexc.to_string exn);

     

       146
       146
       +
               Error (Printf.sprintf "Error reading STDIN: %s" (Printexc.to_string exn))

     

       147
       147
       +
         in

     

       148
       148
       +
         loop ()

     

       149
       149
       +
       

     

       150
       150
       +
       (** Read DATA stream for Filter role *)

     

       151
       151
       +
       let read_data buf_read =

     

       152
       152
       +
         let data_buf = Buffer.create 1024 in

     

       153
       153
       +
         let rec read_data () =

     

       154
       154
       +
           try

     

       155
       155
       +
             let record = Fastcgi_record.read buf_read in

     

       156
       156
       +
             if record.record_type <> Data then

     

       157
       157
       +
               Error "Expected DATA record"

     

       158
       158
       +
             else if is_stream_terminator record then

     

       159
       159
       +
               Ok (Buffer.contents data_buf)

     

       160
       160
       +
             else (

     

       161
       161
       +
               Buffer.add_string data_buf record.content;

     

       162
       162
       +
               read_data ()

     

       163
       163
       +
             )

     

       164
       164
       +
           with

     

       165
       165
       +
           | End_of_file -> Error "Unexpected end of DATA stream"

     

       166
       166
       +
           | exn -> Error (Printf.sprintf "Error reading DATA: %s" (Printexc.to_string exn))

     

       167
       167
       +
         in

     

       168
       168
       +
         read_data ()

     

       169
       169
       +
       

     

       170
       170
       +
       (** Read request streams based on role *)

     

       171
       171
       +
       let read_request_streams request buf_read =

     

       172
       172
       +
         Printf.eprintf "[DEBUG] read_request_streams: Processing role=%s\n%!" 

     

       173
       173
       +
           (Format.asprintf "%a" pp_role request.role);

     

       174
       174
       +
         match request.role with

     

       175
       175
       +
         | Authorizer -> 

     

       176
       176
       +
             Printf.eprintf "[DEBUG] read_request_streams: Authorizer role, no streams to read\n%!";

     

       177
       177
       +
             Ok request

     

       178
       178
       +
         | Responder ->

     

       179
       179
       +
             Printf.eprintf "[DEBUG] read_request_streams: Responder role, reading STDIN\n%!";

     

       180
       180
       +
             let* stdin_data = read_stdin buf_read in

     

       181
       181
       +
             Printf.eprintf "[DEBUG] read_request_streams: Got STDIN data, %d bytes\n%!" (String.length stdin_data);

     

       182
       182
       +
             Ok { request with stdin_data }

     

       183
       183
       +
         | Filter ->

     

       184
       184
       +
             Printf.eprintf "[DEBUG] read_request_streams: Filter role, reading STDIN and DATA\n%!";

     

       185
       185
       +
             let* stdin_data = read_stdin buf_read in

     

       186
       186
       +
             Printf.eprintf "[DEBUG] read_request_streams: Got STDIN data, %d bytes\n%!" (String.length stdin_data);

     

       187
       187
       +
             let request = { request with stdin_data } in

     

       188
       188
       +
             let* data = read_data buf_read in

     

       189
       189
       +
             Printf.eprintf "[DEBUG] read_request_streams: Got DATA stream, %d bytes\n%!" (String.length data);

     

       190
       190
       +
             Ok { request with data_stream = Some data }

     

       191
       191
       +
       

     

       192
       192
       +
       let read_request buf_read =

     

       193
       193
       +
         Printf.eprintf "[DEBUG] read_request: Starting\n%!";

     

       194
       194
       +
         try

     

       195
       195
       +
           (* Read BEGIN_REQUEST *)

     

       196
       196
       +
           Printf.eprintf "[DEBUG] read_request: Reading BEGIN_REQUEST record\n%!";

     

       197
       197
       +
           let begin_record = Fastcgi_record.read buf_read in

     

       198
       198
       +
           Printf.eprintf "[DEBUG] read_request: Got BEGIN_REQUEST record: %s\n%!"

     

       199
       199
       +
             (Format.asprintf "%a" (Fastcgi_record.pp ~max_content_len:50) begin_record);

     

       200
       200
       +
           let* request = create begin_record in

     

       201
       201
       +
           Printf.eprintf "[DEBUG] read_request: Created request with role=%s, id=%d\n%!"

     

       202
       202
       +
             (Format.asprintf "%a" pp_role request.role) request.request_id;

     

       203
       203
       +
           (* Read PARAMS stream *)

     

       204
       204
       +
           Printf.eprintf "[DEBUG] read_request: Reading PARAMS stream\n%!";

     

       205
       205
       +
           let* params = read_params buf_read in

     

       206
       206
       +
           Printf.eprintf "[DEBUG] read_request: Got %d params\n%!" (Fastcgi_record.KV.cardinal params);

     

       207
       207
       +
           let request = { request with params } in

     

       208
       208
       +
           (* Read remaining streams based on role *)

     

       209
       209
       +
           Printf.eprintf "[DEBUG] read_request: Reading streams for role=%s\n%!"

     

       210
       210
       +
             (Format.asprintf "%a" pp_role request.role);

     

       211
       211
       +
           let result = read_request_streams request buf_read in

     

       212
       212
       +
           Printf.eprintf "[DEBUG] read_request: Finished reading request\n%!";

     

       213
       213
       +
           result

     

       214
       214
       +
         with

     

       215
       215
       +
         | End_of_file -> 

     

       216
       216
       +
             Printf.eprintf "[DEBUG] read_request: Hit End_of_file\n%!";

     

       217
       217
       +
             Error "Unexpected end of stream"

     

       218
       218
       +
         | exn -> 

     

       219
       219
       +
             Printf.eprintf "[DEBUG] read_request: Exception: %s\n%!" (Printexc.to_string exn);

     

       220
       220
       +
             Error (Printf.sprintf "Error reading request: %s" (Printexc.to_string exn))

     

       221
       221
       +
       

     

       222
       222
       +
       (** {1 Response Generation} *)

     

       223
       223
       +
       

     

       224
       224
       +
       type app_status = int

     

       225
       225
       +
       type protocol_status = 

     

       226
       226
       +
         | Request_complete

     

       227
       227
       +
         | Cant_mpx_conn  

     

       228
       228
       +
         | Overloaded

     

       229
       229
       +
         | Unknown_role

     

       230
       230
       +
       

     

       231
       231
       +
       let pp_protocol_status ppf = function

     

       232
       232
       +
         | Request_complete -> Format.pp_print_string ppf "Request_complete"

     

       233
       233
       +
         | Cant_mpx_conn -> Format.pp_print_string ppf "Cant_mpx_conn"

     

       234
       234
       +
         | Overloaded -> Format.pp_print_string ppf "Overloaded"

     

       235
       235
       +
         | Unknown_role -> Format.pp_print_string ppf "Unknown_role"

     

       236
       236
       +
       

     

       237
       237
       +
       let protocol_status_to_int = function

     

       238
       238
       +
         | Request_complete -> 0

     

       239
       239
       +
         | Cant_mpx_conn -> 1

     

       240
       240
       +
         | Overloaded -> 2

     

       241
       241
       +
         | Unknown_role -> 3

     

       242
       242
       +
       

     

       243
       243
       +
       let write_stream_records buf_write request_id record_type content =

     

       244
       244
       +
         let max_chunk = 65535 in (* FastCGI max record content length *)

     

       245
       245
       +
         let len = String.length content in

     

       246
       246
       +
         let rec chunk_string pos =

     

       247
       247
       +
           if pos < len then begin

     

       248
       248
       +
             let chunk_len = min max_chunk (len - pos) in

     

       249
       249
       +
             let record = Fastcgi_record.create ~record:record_type ~request_id ~content ~offset:pos ~length:chunk_len () in

     

       250
       250
       +
             Fastcgi_record.write buf_write record;

     

       251
       251
       +
             chunk_string (pos + chunk_len)

     

       252
       252
       +
           end

     

       253
       253
       +
         in

     

       254
       254
       +
         chunk_string 0;

     

       255
       255
       +
         let terminator = Fastcgi_record.create ~record:record_type ~request_id ~content:"" () in

     

       256
       256
       +
         Fastcgi_record.write buf_write terminator

     

       257
       257
       +
       

     

       258
       258
       +
       let write_stdout_records buf_write request_id content =

     

       259
       259
       +
         Printf.eprintf "[DEBUG] write_stdout_records: Writing %d bytes for request_id=%d\n%!" 

     

       260
       260
       +
           (String.length content) request_id;

     

       261
       261
       +
         write_stream_records buf_write request_id Stdout content

     

       262
       262
       +
       

     

       263
       263
       +
       let write_stderr_records buf_write request_id content =

     

       264
       264
       +
         Printf.eprintf "[DEBUG] write_stderr_records: Writing %d bytes for request_id=%d\n%!" 

     

       265
       265
       +
           (String.length content) request_id;

     

       266
       266
       +
         write_stream_records buf_write request_id Stderr content

     

       267
       267
       +
       

     

       268
       268
       +
       let write_end_request buf_write request_id app_status protocol_status =

     

       269
       269
       +
         let content = 

     

       270
       270
       +
           let buf = Bytes.create 8 in

     

       271
       271
       +
           Bytes.set_int32_be buf 0 (Int32.of_int app_status);

     

       272
       272
       +
           Bytes.set_uint8 buf 4 (protocol_status_to_int protocol_status);

     

       273
       273
       +
           Bytes.set_uint8 buf 5 0; (* reserved *)

     

       274
       274
       +
           Bytes.set_uint8 buf 6 0; (* reserved *)

     

       275
       275
       +
           Bytes.set_uint8 buf 7 0; (* reserved *)

     

       276
       276
       +
           Bytes.to_string buf

     

       277
       277
       +
         in

     

       278
       278
       +
         let record = Fastcgi_record.create ~record:End_request ~request_id ~content () in

     

       279
       279
       +
         Fastcgi_record.write buf_write record

+80

lib/fastcgi_request.mli

···

       1
       1
       +
       (** FastCGI request handling with functional state management and Eio flows.

     

       2
       2
       +
       

     

       3
       3
       +
           This module provides a functional approach to FastCGI request processing,

     

       4
       4
       +
           using immutable data structures and higher-order functions. Input and output

     

       5
       5
       +
           are handled through Eio flows for efficient streaming I/O. *)

     

       6
       6
       +
       

     

       7
       7
       +
       (** {1 Request Roles} *)

     

       8
       8
       +
       

     

       9
       9
       +
       (** FastCGI application roles defining request processing behavior *)

     

       10
       10
       +
       type role =

     

       11
       11
       +
         | Responder   (** Standard CGI-like request/response processing *)

     

       12
       12
       +
         | Authorizer  (** Authorization decision with optional variables *)

     

       13
       13
       +
         | Filter      (** Content filtering with additional data stream *)

     

       14
       14
       +
       

     

       15
       15
       +
       (** [pp_role ppf role] pretty-prints a FastCGI role *)

     

       16
       16
       +
       val pp_role : Format.formatter -> role -> unit

     

       17
       17
       +
       

     

       18
       18
       +
       (** [role_of_begin_request record] extracts role from BEGIN_REQUEST record *)

     

       19
       19
       +
       val role_of_begin_request : Fastcgi_record.t -> (role, string) result

     

       20
       20
       +
       

     

       21
       21
       +
       (** {1 Request Context} *)

     

       22
       22
       +
       

     

       23
       23
       +
       (** Immutable request context containing all request data *)

     

       24
       24
       +
       type t = private {

     

       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
       28
       +
         params : Fastcgi_record.KV.t;            (** Environment parameters *)

     

       29
       29
       +
         stdin_data : string;                     (** Complete STDIN content *)

     

       30
       30
       +
         data_stream : string option;             (** DATA stream for Filter role *)

     

       31
       31
       +
       }

     

       32
       32
       +
       

     

       33
       33
       +
       (** [pp ppf request] pretty-prints a request context *)

     

       34
       34
       +
       val pp : Format.formatter -> t -> unit

     

       35
       35
       +
       

     

       36
       36
       +
       (** [create record] creates request context from BEGIN_REQUEST record *)

     

       37
       37
       +
       val create : Fastcgi_record.t -> (t, string) result

     

       38
       38
       +
       

     

       39
       39
       +
       (** {1 Stream Processing} *)

     

       40
       40
       +
       

     

       41
       41
       +
       (** [read_params buf_read] reads PARAMS stream from buf_read until empty record.

     

       42
       42
       +
           Returns the accumulated parameters. *)

     

       43
       43
       +
       val read_params : Eio.Buf_read.t -> (Fastcgi_record.KV.t, string) result

     

       44
       44
       +
       

     

       45
       45
       +
       (** [read_stdin buf_read] reads STDIN stream from buf_read until empty record.

     

       46
       46
       +
           Returns the accumulated data. *)

     

       47
       47
       +
       val read_stdin : Eio.Buf_read.t -> (string, string) result

     

       48
       48
       +
       

     

       49
       49
       +
       (** [read_data buf_read] reads DATA stream from buf_read until empty record.

     

       50
       50
       +
           Returns the accumulated data for Filter role. *)

     

       51
       51
       +
       val read_data : Eio.Buf_read.t -> (string, string) result

     

       52
       52
       +
       

     

       53
       53
       +
       (** [read_request buf_read] reads a complete FastCGI request from buf_read.

     

       54
       54
       +
           Processes BEGIN_REQUEST, PARAMS, STDIN, and DATA records until complete.

     

       55
       55
       +
           Returns the populated request context. *)

     

       56
       56
       +
       val read_request : Eio.Buf_read.t -> (t, string) result

     

       57
       57
       +
       

     

       58
       58
       +
       (** {1 Response Generation} *)

     

       59
       59
       +
       

     

       60
       60
       +
       (** Response status codes *)

     

       61
       61
       +
       type app_status = int

     

       62
       62
       +
       type protocol_status = 

     

       63
       63
       +
         | Request_complete

     

       64
       64
       +
         | Cant_mpx_conn  

     

       65
       65
       +
         | Overloaded

     

       66
       66
       +
         | Unknown_role

     

       67
       67
       +
       

     

       68
       68
       +
       (** [pp_protocol_status ppf status] pretty-prints protocol status *)

     

       69
       69
       +
       val pp_protocol_status : Format.formatter -> protocol_status -> unit

     

       70
       70
       +
       

     

       71
       71
       +
       (** [write_stdout_records buf_write request_id content] writes STDOUT stream records.

     

       72
       72
       +
           Splits content into chunks and writes with terminator. *)

     

       73
       73
       +
       val write_stdout_records : Eio.Buf_write.t -> Fastcgi_record.request_id -> string -> unit

     

       74
       74
       +
       

     

       75
       75
       +
       (** [write_stderr_records buf_write request_id content] writes STDERR stream records.

     

       76
       76
       +
           Splits content into chunks and writes with terminator. *)

     

       77
       77
       +
       val write_stderr_records : Eio.Buf_write.t -> Fastcgi_record.request_id -> string -> unit

     

       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

+13

test/dune

···

       1
       1
       +
       (test

     

       2
       2
       +
        (name simple_test)

     

       3
       3
       +
        (modules simple_test)

     

       4
       4
       +
        (libraries fastcgi eio eio_main)

     

       5
       5
       +
        (deps (source_tree test_cases))

     

       6
       6
       +
       )

     

       7
       7
       +
       

     

       8
       8
       +
       (test

     

       9
       9
       +
        (name validate_all_test_cases)

     

       10
       10
       +
        (modules validate_all_test_cases)

     

       11
       11
       +
        (libraries fastcgi eio eio_main)

     

       12
       12
       +
        (deps (source_tree test_cases))

     

       13
       13
       +
       )

+161

test/simple_test.ml

···

       1
       1
       +
       open Fastcgi

     

       2
       2
       +
       

     

       3
       3
       +
       let hex_dump ?(max_bytes=256) content =

     

       4
       4
       +
         let len = String.length content in

     

       5
       5
       +
         let display_len = min len max_bytes in

     

       6
       6
       +
         let bytes_per_line = 16 in

     

       7
       7
       +
         let lines_to_show = (display_len - 1) / bytes_per_line + 1 in

     

       8
       8
       +
         

     

       9
       9
       +
         for i = 0 to lines_to_show - 1 do

     

       10
       10
       +
           let start = i * bytes_per_line in

     

       11
       11
       +
           let end_ = min (start + bytes_per_line) display_len in

     

       12
       12
       +
           Printf.printf "  %04x: " start;

     

       13
       13
       +
           

     

       14
       14
       +
           (* Print hex bytes *)

     

       15
       15
       +
           for j = start to end_ - 1 do

     

       16
       16
       +
             Printf.printf "%02x " (Char.code content.[j]);

     

       17
       17
       +
             if j = start + 7 then Printf.printf " "

     

       18
       18
       +
           done;

     

       19
       19
       +
           

     

       20
       20
       +
           (* Pad remaining space *)

     

       21
       21
       +
           for _ = end_ to start + bytes_per_line - 1 do

     

       22
       22
       +
             Printf.printf "   ";

     

       23
       23
       +
             if end_ <= start + 7 then Printf.printf " "

     

       24
       24
       +
           done;

     

       25
       25
       +
           

     

       26
       26
       +
           Printf.printf " |";

     

       27
       27
       +
           

     

       28
       28
       +
           (* Print ASCII representation *)

     

       29
       29
       +
           for j = start to end_ - 1 do

     

       30
       30
       +
             let c = content.[j] in

     

       31
       31
       +
             if c >= ' ' && c <= '~' then

     

       32
       32
       +
               Printf.printf "%c" c

     

       33
       33
       +
             else

     

       34
       34
       +
               Printf.printf "."

     

       35
       35
       +
           done;

     

       36
       36
       +
           

     

       37
       37
       +
           Printf.printf "|\n%!"

     

       38
       38
       +
         done;

     

       39
       39
       +
         

     

       40
       40
       +
         if len > max_bytes then

     

       41
       41
       +
           Printf.printf "  ... (%d more bytes truncated)\n%!" (len - max_bytes)

     

       42
       42
       +
       

     

       43
       43
       +
       

     

       44
       44
       +
       let test_record_types () =

     

       45
       45
       +
         Printf.printf "Testing record type conversions...\n%!";

     

       46
       46
       +
         

     

       47
       47
       +
         let test_type rt expected_int =

     

       48
       48
       +
           assert (Record.record_to_int rt = expected_int);

     

       49
       49
       +
           assert (Record.record_of_int expected_int = rt)

     

       50
       50
       +
         in

     

       51
       51
       +
         

     

       52
       52
       +
         test_type Begin_request 1;

     

       53
       53
       +
         test_type Abort_request 2;

     

       54
       54
       +
         test_type End_request 3;

     

       55
       55
       +
         test_type Params 4;

     

       56
       56
       +
         test_type Stdin 5;

     

       57
       57
       +
         test_type Stdout 6;

     

       58
       58
       +
         test_type Stderr 7;

     

       59
       59
       +
         test_type Data 8;

     

       60
       60
       +
         test_type Get_values 9;

     

       61
       61
       +
         test_type Get_values_result 10;

     

       62
       62
       +
         test_type Unknown_type 11;

     

       63
       63
       +
         

     

       64
       64
       +
         (* Test invalid record type *)

     

       65
       65
       +
         (try

     

       66
       66
       +
            let _ = Record.record_of_int 99 in

     

       67
       67
       +
            assert false (* Should not reach here *)

     

       68
       68
       +
          with Invalid_argument _ -> ());

     

       69
       69
       +
         

     

       70
       70
       +
         Printf.printf "✓ Record type conversion test passed\n%!"

     

       71
       71
       +
       

     

       72
       72
       +
       let test_kv_encoding () =

     

       73
       73
       +
         Printf.printf "Testing key-value encoding...\n%!";

     

       74
       74
       +
         

     

       75
       75
       +
         let kv = Record.KV.empty

     

       76
       76
       +
           |> Record.KV.add "REQUEST_METHOD" "GET"

     

       77
       77
       +
           |> Record.KV.add "SERVER_NAME" "localhost"

     

       78
       78
       +
           |> Record.KV.add "SERVER_PORT" "80"

     

       79
       79
       +
         in

     

       80
       80
       +
         

     

       81
       81
       +
         let encoded = Record.KV.encode kv in

     

       82
       82
       +
         let decoded = Record.KV.decode encoded in

     

       83
       83
       +
         

     

       84
       84
       +
         (* Check that all original pairs are present *)

     

       85
       85
       +
         assert (Record.KV.find "REQUEST_METHOD" decoded = "GET");

     

       86
       86
       +
         assert (Record.KV.find "SERVER_NAME" decoded = "localhost");

     

       87
       87
       +
         assert (Record.KV.find "SERVER_PORT" decoded = "80");

     

       88
       88
       +
         

     

       89
       89
       +
         Printf.printf "✓ Key-value encoding test passed\n%!"

     

       90
       90
       +
       

     

       91
       91
       +
       let test_long_key_value () =

     

       92
       92
       +
         Printf.printf "Testing long key-value encoding...\n%!";

     

       93
       93
       +
         

     

       94
       94
       +
         (* Create a long key and value to test 4-byte length encoding *)

     

       95
       95
       +
         let long_key = String.make 200 'k' in

     

       96
       96
       +
         let long_value = String.make 300 'v' in

     

       97
       97
       +
         

     

       98
       98
       +
         let kv = Record.KV.empty

     

       99
       99
       +
           |> Record.KV.add long_key long_value

     

       100
       100
       +
           |> Record.KV.add "short" "val"

     

       101
       101
       +
         in

     

       102
       102
       +
         

     

       103
       103
       +
         let encoded = Record.KV.encode kv in

     

       104
       104
       +
         let decoded = Record.KV.decode encoded in

     

       105
       105
       +
         

     

       106
       106
       +
         assert (Record.KV.find long_key decoded = long_value);

     

       107
       107
       +
         assert (Record.KV.find "short" decoded = "val");

     

       108
       108
       +
         

     

       109
       109
       +
         Printf.printf "✓ Long key-value encoding test passed\n%!"

     

       110
       110
       +
       

     

       111
       111
       +
       let test_with_binary_test_case ~fs filename expected_type expected_request_id =

     

       112
       112
       +
         Printf.printf "Testing with binary test case: %s...\n%!" filename;

     

       113
       113
       +
         

     

       114
       114
       +
         let (raw_content, parsed) = 

     

       115
       115
       +
           Eio.Path.with_open_in (fs, "test_cases/" ^ filename) @@ fun flow ->

     

       116
       116
       +
           let buf = Buffer.create 1024 in

     

       117
       117
       +
           Eio.Flow.copy flow (Eio.Flow.buffer_sink buf);

     

       118
       118
       +
           let raw_content = Buffer.contents buf in

     

       119
       119
       +
           let buf_read = Eio.Buf_read.of_string raw_content in

     

       120
       120
       +
           let parsed = Record.read buf_read in

     

       121
       121
       +
           (raw_content, parsed)

     

       122
       122
       +
         in

     

       123
       123
       +
         

     

       124
       124
       +
         Printf.printf "\nRaw file contents (%d bytes):\n" (String.length raw_content);

     

       125
       125
       +
         hex_dump raw_content;

     

       126
       126
       +
         

     

       127
       127
       +
         Printf.printf "\nParsed record:\n";

     

       128
       128
       +
         Format.printf "%a\n" (fun ppf -> Record.pp ppf) parsed;

     

       129
       129
       +
         

     

       130
       130
       +
         (* If this is a Params record, also show the decoded key-value pairs *)

     

       131
       131
       +
         if parsed.record_type = Params && String.length parsed.content > 0 then (

     

       132
       132
       +
           let params = Record.KV.decode parsed.content in

     

       133
       133
       +
           Printf.printf "\nDecoded parameters:\n";

     

       134
       134
       +
           Format.printf "%a\n" Record.KV.pp params

     

       135
       135
       +
         );

     

       136
       136
       +
         

     

       137
       137
       +
         assert (parsed.version = 1);

     

       138
       138
       +
         assert (parsed.record_type = expected_type);

     

       139
       139
       +
         assert (parsed.request_id = expected_request_id);

     

       140
       140
       +
         

     

       141
       141
       +
         Printf.printf "✓ Binary test case %s passed\n%!" filename

     

       142
       142
       +
       

     

       143
       143
       +
       let run_tests ~fs =

     

       144
       144
       +
         Printf.printf "Running FastCGI Record tests...\n\n%!";

     

       145
       145
       +
         

     

       146
       146
       +
         test_record_types ();

     

       147
       147
       +
         test_kv_encoding ();

     

       148
       148
       +
         test_long_key_value ();

     

       149
       149
       +
         

     

       150
       150
       +
         (* Test with some of our binary test cases *)

     

       151
       151
       +
         test_with_binary_test_case ~fs "begin_request_responder.bin" Begin_request 1;

     

       152
       152
       +
         test_with_binary_test_case ~fs "params_empty.bin" Params 1;

     

       153
       153
       +
         test_with_binary_test_case ~fs "end_request_success.bin" End_request 1;

     

       154
       154
       +
         test_with_binary_test_case ~fs "get_values.bin" Get_values 0;

     

       155
       155
       +
         test_with_binary_test_case ~fs "abort_request.bin" Abort_request 1;

     

       156
       156
       +
         

     

       157
       157
       +
         Printf.printf "\n✅ All FastCGI Record tests passed!\n%!"

     

       158
       158
       +
       

     

       159
       159
       +
       let () = Eio_main.run @@ fun env ->

     

       160
       160
       +
         let fs = Eio.Stdenv.cwd env in

     

       161
       161
       +
         run_tests ~fs:(fst fs)

+123

test/test_cases/README.md

···

       1
       1
       +
       # FastCGI Test Cases

     

       2
       2
       +
       

     

       3
       3
       +
       This directory contains binary test case files representing various FastCGI records as defined in the FastCGI specification. These files can be used to test a FastCGI parser implementation.

     

       4
       4
       +
       

     

       5
       5
       +
       ## Test Case Files

     

       6
       6
       +
       

     

       7
       7
       +
       ### Management Records (requestId = 0)

     

       8
       8
       +
       

     

       9
       9
       +
       - **`get_values.bin`** - FCGI_GET_VALUES record requesting capability information

     

       10
       10
       +
       - **`get_values_result.bin`** - FCGI_GET_VALUES_RESULT record with capability responses

     

       11
       11
       +
       - **`unknown_type.bin`** - FCGI_UNKNOWN_TYPE record for unrecognized record types

     

       12
       12
       +
       

     

       13
       13
       +
       ### Application Records (requestId > 0)

     

       14
       14
       +
       

     

       15
       15
       +
       #### BEGIN_REQUEST Records

     

       16
       16
       +
       - **`begin_request_responder.bin`** - Begin request for Responder role with KEEP_CONN flag

     

       17
       17
       +
       - **`begin_request_no_keep.bin`** - Begin request for Responder role without KEEP_CONN flag

     

       18
       18
       +
       - **`begin_request_authorizer.bin`** - Begin request for Authorizer role

     

       19
       19
       +
       - **`begin_request_filter.bin`** - Begin request for Filter role

     

       20
       20
       +
       

     

       21
       21
       +
       #### Stream Records

     

       22
       22
       +
       - **`params_get.bin`** - FCGI_PARAMS record with GET request environment variables

     

       23
       23
       +
       - **`params_post.bin`** - FCGI_PARAMS record with POST request environment variables

     

       24
       24
       +
       - **`params_empty.bin`** - Empty FCGI_PARAMS record (end of params stream)

     

       25
       25
       +
       - **`stdin_form_data.bin`** - FCGI_STDIN record with form data

     

       26
       26
       +
       - **`stdin_empty.bin`** - Empty FCGI_STDIN record (end of stdin stream)

     

       27
       27
       +
       - **`stdout_response.bin`** - FCGI_STDOUT record with HTTP response

     

       28
       28
       +
       - **`stdout_empty.bin`** - Empty FCGI_STDOUT record (end of stdout stream)

     

       29
       29
       +
       - **`stderr_message.bin`** - FCGI_STDERR record with error message

     

       30
       30
       +
       - **`stderr_empty.bin`** - Empty FCGI_STDERR record (end of stderr stream)

     

       31
       31
       +
       - **`data_filter.bin`** - FCGI_DATA record with file content (for Filter role)

     

       32
       32
       +
       - **`data_empty.bin`** - Empty FCGI_DATA record (end of data stream)

     

       33
       33
       +
       

     

       34
       34
       +
       #### Control Records

     

       35
       35
       +
       - **`end_request_success.bin`** - FCGI_END_REQUEST record with successful completion

     

       36
       36
       +
       - **`end_request_error.bin`** - FCGI_END_REQUEST record with error status

     

       37
       37
       +
       - **`abort_request.bin`** - FCGI_ABORT_REQUEST record

     

       38
       38
       +
       

     

       39
       39
       +
       ### Complex Scenarios

     

       40
       40
       +
       - **`multiplexed_requests.bin`** - Multiple concurrent requests on same connection

     

       41
       41
       +
       - **`large_record.bin`** - Record with maximum content size (65KB)

     

       42
       42
       +
       - **`padded_record.bin`** - Record with padding for 8-byte alignment

     

       43
       43
       +
       

     

       44
       44
       +
       ## Record Format

     

       45
       45
       +
       

     

       46
       46
       +
       All records follow the FastCGI record format:

     

       47
       47
       +
       

     

       48
       48
       +
       ```

     

       49
       49
       +
       typedef struct {

     

       50
       50
       +
           unsigned char version;           // FCGI_VERSION_1 (1)

     

       51
       51
       +
           unsigned char type;              // Record type (1-11)

     

       52
       52
       +
           unsigned char requestIdB1;       // Request ID high byte

     

       53
       53
       +
           unsigned char requestIdB0;       // Request ID low byte

     

       54
       54
       +
           unsigned char contentLengthB1;   // Content length high byte

     

       55
       55
       +
           unsigned char contentLengthB0;   // Content length low byte

     

       56
       56
       +
           unsigned char paddingLength;     // Padding length

     

       57
       57
       +
           unsigned char reserved;          // Reserved (always 0)

     

       58
       58
       +
           // contentData[contentLength]

     

       59
       59
       +
           // paddingData[paddingLength]

     

       60
       60
       +
       } FCGI_Record;

     

       61
       61
       +
       ```

     

       62
       62
       +
       

     

       63
       63
       +
       ## Usage for Parser Testing

     

       64
       64
       +
       

     

       65
       65
       +
       These test cases can be used to verify:

     

       66
       66
       +
       

     

       67
       67
       +
       1. **Header parsing** - Correct extraction of version, type, requestId, lengths

     

       68
       68
       +
       2. **Content parsing** - Proper handling of record body data

     

       69
       69
       +
       3. **Stream handling** - Recognition of stream start/end patterns

     

       70
       70
       +
       4. **Name-value pair parsing** - Decoding of FCGI_PARAMS format

     

       71
       71
       +
       5. **Role-specific parsing** - Different record sequences for each role

     

       72
       72
       +
       6. **Error handling** - Response to unknown types, malformed data

     

       73
       73
       +
       7. **Multiplexing** - Handling multiple concurrent request IDs

     

       74
       74
       +
       8. **Padding** - Correct skipping of padding bytes

     

       75
       75
       +
       

     

       76
       76
       +
       ## Typical Protocol Flows

     

       77
       77
       +
       

     

       78
       78
       +
       ### Simple Responder Request

     

       79
       79
       +
       1. `begin_request_responder.bin`

     

       80
       80
       +
       2. `params_get.bin`

     

       81
       81
       +
       3. `params_empty.bin`

     

       82
       82
       +
       4. `stdin_empty.bin`

     

       83
       83
       +
       5. `stdout_response.bin`

     

       84
       84
       +
       6. `stdout_empty.bin`

     

       85
       85
       +
       7. `end_request_success.bin`

     

       86
       86
       +
       

     

       87
       87
       +
       ### POST Request with Form Data

     

       88
       88
       +
       1. `begin_request_responder.bin`

     

       89
       89
       +
       2. `params_post.bin`

     

       90
       90
       +
       3. `params_empty.bin`

     

       91
       91
       +
       4. `stdin_form_data.bin`

     

       92
       92
       +
       5. `stdin_empty.bin`

     

       93
       93
       +
       6. `stdout_response.bin`

     

       94
       94
       +
       7. `stdout_empty.bin`

     

       95
       95
       +
       8. `end_request_success.bin`

     

       96
       96
       +
       

     

       97
       97
       +
       ### Authorizer Request

     

       98
       98
       +
       1. `begin_request_authorizer.bin`

     

       99
       99
       +
       2. `params_get.bin`

     

       100
       100
       +
       3. `params_empty.bin`

     

       101
       101
       +
       4. `stdout_response.bin`

     

       102
       102
       +
       5. `stdout_empty.bin`

     

       103
       103
       +
       6. `end_request_success.bin`

     

       104
       104
       +
       

     

       105
       105
       +
       ### Filter Request

     

       106
       106
       +
       1. `begin_request_filter.bin`

     

       107
       107
       +
       2. `params_get.bin`

     

       108
       108
       +
       3. `params_empty.bin`

     

       109
       109
       +
       4. `stdin_empty.bin`

     

       110
       110
       +
       5. `data_filter.bin`

     

       111
       111
       +
       6. `data_empty.bin`

     

       112
       112
       +
       7. `stdout_response.bin`

     

       113
       113
       +
       8. `stdout_empty.bin`

     

       114
       114
       +
       9. `end_request_success.bin`

     

       115
       115
       +
       

     

       116
       116
       +
       ## Binary Format Verification

     

       117
       117
       +
       

     

       118
       118
       +
       You can inspect the binary content using hexdump:

     

       119
       119
       +
       ```bash

     

       120
       120
       +
       hexdump -C begin_request_responder.bin

     

       121
       121
       +
       ```

     

       122
       122
       +
       

     

       123
       123
       +
       The first 8 bytes should always be the FastCGI header, followed by the record content and any padding.

test/test_cases/abort_request.bin