commit f9c75292c661c1354cc3d35966b3f307c1ead859 · anil.recoil.org/ocaml-fastcgi

bin/dune

···

       1
       1
       +
       (executable

     

       2
       2
       +
        (public_name fcgi-server)

     

       3
       3
       +
        (name fcgi_server)

     

       4
       4
       +
        (libraries cmdliner eio eio_main fastcgi))

+32

bin/fcgi_server.ml

···

       1
       1
       +
       open Cmdliner

     

       2
       2
       +
       

     

       3
       3
       +
       let run port =

     

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

     

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

     

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

     

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

     

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

     

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

     

       10
       10
       +
         Eio.Net.run_server server_socket ~on_error:(fun ex -> Eio.traceln "Error: %s" (Printexc.to_string ex))

     

       11
       11
       +
         @@ fun flow addr ->

     

       12
       12
       +
         Eio.traceln "Accepted connection from %a" Eio.Net.Sockaddr.pp addr;

     

       13
       13
       +
         (* Here you would handle the FastCGI protocol, but for simplicity, we just echo a string. *)

     

       14
       14
       +
         let req = Fastcgi.Request.read_request_from_flow ~sw flow in

     

       15
       15
       +
         match req with

     

       16
       16
       +
         | Error msg ->

     

       17
       17
       +
             Eio.traceln "Failed to read request: %s" msg;

     

       18
       18
       +
             Eio.Flow.close flow

     

       19
       19
       +
         | Ok req ->

     

       20
       20
       +
             Eio.traceln "Received request: %a" Fastcgi.Request.pp req;

     

       21
       21
       +
             Eio.Flow.close flow

     

       22
       22
       +
       

     

       23
       23
       +
       let port =

     

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

     

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

     

       26
       26
       +
       

     

       27
       27
       +
       let cmd =

     

       28
       28
       +
         let doc = "FastCGI server" in

     

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

     

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

     

       31
       31
       +
       

     

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

+3 -1

dune-project

···

       20
       20
        
        (depends 

     

       21
       21
        
         ocaml 

     

       22
       22
        
         dune

     

       23
       23
       -
         eio)

     

       23
       23
       +
         eio

     

       24
       24
       +
         cmdliner

     

       25
       25
       +
         eio_main)

     

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

     

       25
       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."))

fastcgi.opam

···

       13
       13
        
         "ocaml"

     

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

     

       15
       15
        
         "eio"

     

       16
       16
       +
         "cmdliner"

     

       17
       17
       +
         "eio_main"

     

       16
       18
        
         "odoc" {with-doc}

     

       17
       19
        
       ]

     

       18
       20
        
       build: [

+25 -6

lib/fastcgi_record.ml

···

       98
       98
        
       let fcgi_header_len = 8

     

       99
       99
        
       

     

       100
       100
        
       let read buf_read =

     

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

     

       101
       102
        
         (* Read the 8-byte header *)

     

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

     

       102
       104
        
         let header = Eio.Buf_read.take fcgi_header_len buf_read in

     

       103
       105
        
         

     

       104
       106
        
         (* Parse header fields *)

     
···

       109
       111
        
         let padding_length = Char.code header.[6] in

     

       110
       112
        
         let _reserved = Char.code header.[7] in

     

       111
       113
        
         

     

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

     

       115
       115
       +
           version record_type_int request_id content_length padding_length;

     

       116
       116
       +
         

     

       112
       117
        
         (* Validate version *)

     

       113
       118
        
         if version <> fcgi_version_1 then invalid_version version;

     

       114
       119
        
         

     

       115
       120
        
         (* Convert record type *)

     

       116
       121
        
         let record_type = record_of_int record_type_int in

     

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

     

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

     

       117
       124
        
         

     

       118
       125
        
         (* Read content *)

     

       119
       126
        
         let content = 

     

       120
       120
       -
           if content_length = 0 then

     

       127
       127
       +
           if content_length = 0 then (

     

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

     

       121
       129
        
             ""

     

       122
       122
       -
           else

     

       123
       123
       -
             Eio.Buf_read.take content_length buf_read

     

       130
       130
       +
           ) else (

     

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

     

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

     

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

     

       134
       134
       +
             c

     

       135
       135
       +
           )

     

       124
       136
        
         in

     

       125
       137
        
         

     

       126
       138
        
         (* Skip padding *)

     

       127
       127
       -
         if padding_length > 0 then

     

       128
       128
       -
           ignore (Eio.Buf_read.take padding_length buf_read);

     

       139
       139
       +
         if padding_length > 0 then (

     

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

     

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

     

       142
       142
       +
         );

     

       129
       143
        
         

     

       130
       130
       -
         { version; record_type; request_id; content }

     

       144
       144
       +
         let record = { version; record_type; request_id; content } in

     

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

     

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

     

       147
       147
       +
         record

     

       131
       148
        
       

     

       132
       149
        
       let write buf_write record =

     

       133
       150
        
         let content_length = String.length record.content in

     
···

       165
       182
        
         let add key value kvs = (key, value) :: kvs

     

       166
       183
        
       

     

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

     

       185
       185
       +
         

     

       186
       186
       +
         let cardinal kvs = List.length kvs

     

       168
       187
        
       

     

       169
       188
        
         let find key kvs = 

     

       170
       189
        
           try List.assoc key kvs

lib/fastcgi_record.mli

···

       103
       103
        
       

     

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

     

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

     

       106
       106
       +
         

     

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

     

       108
       108
       +
         val cardinal : t -> int

     

       106
       109
        
       

     

       107
       110
        
         (** [read buf_read] reads key-value pairs from a buffer.

     

       108
       111
        
             Handles the FastCGI variable-length encoding where lengths ≤ 127 bytes

+67 -19

lib/fastcgi_request.ml

···

       79
       79
        
         String.length record.content = 0

     

       80
       80
        
       

     

       81
       81
        
       

     

       82
       82
       -
       let read_params_from_flow ~sw:_ flow =

     

       83
       83
       -
         let buf_read = Eio.Buf_read.of_flow flow ~max_size:1000000 in

     

       82
       82
       +
       let read_params_from_flow ~sw:_ 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%!";

     

       87
       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);

     

       88
       92
        
             if record.record_type <> Params then

     

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

     

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

     

       91
       91
       -
             else if is_stream_terminator record then

     

       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);

     

       92
       98
        
               Ok !params

     

       93
       93
       -
             else (

     

       99
       99
       +
             ) else (

     

       94
       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);

     

       95
       103
        
               params := KV.to_seq record_params

     

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

     

       97
       105
        
               loop ()

     

       98
       106
        
             )

     

       99
       107
        
           with

     

       100
       100
       -
           | End_of_file -> Error "Unexpected end of stream while reading PARAMS"

     

       101
       101
       -
           | exn -> Error (Printf.sprintf "Error reading PARAMS: %s" (Printexc.to_string exn))

     

       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))

     

       102
       114
        
         in

     

       103
       115
        
         loop ()

     

       104
       116
        
       

     

       105
       105
       -
       let read_stdin_from_flow ~sw:_ flow =

     

       106
       106
       -
         let buf_read = Eio.Buf_read.of_flow flow ~max_size:1000000 in

     

       117
       117
       +
       let read_stdin_from_flow ~sw:_ buf_read =

     

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

     

       107
       119
        
         let data = Buffer.create 1024 in

     

       108
       120
        
         let rec loop () =

     

       109
       121
        
           try

     

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

     

       110
       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);

     

       111
       127
        
             if record.record_type <> Stdin then

     

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

     

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

     

       114
       114
       -
             else if is_stream_terminator record then

     

       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);

     

       115
       133
        
               Ok (Buffer.contents data)

     

       116
       116
       -
             else (

     

       134
       134
       +
             ) else (

     

       117
       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);

     

       118
       138
        
               loop ()

     

       119
       139
        
             )

     

       120
       140
        
           with

     

       121
       121
       -
           | End_of_file -> Error "Unexpected end of stream while reading STDIN"

     

       122
       122
       -
           | exn -> Error (Printf.sprintf "Error reading STDIN: %s" (Printexc.to_string exn))

     

       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))

     

       123
       147
        
         in

     

       124
       148
        
         loop ()

     

       125
       149
        
       

     
···

       144
       168
        
         read_data ()

     

       145
       169
        
       

     

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

     

       147
       147
       -
       let read_request_streams ~sw request flow buf_read =

     

       171
       171
       +
       let read_request_streams ~sw request buf_read =

     

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

     

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

     

       148
       174
        
         match request.role with

     

       149
       175
        
         | Authorizer -> 

     

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

     

       150
       177
        
             Ok request

     

       151
       178
        
         | Responder ->

     

       152
       152
       -
             let* stdin_data = read_stdin_from_flow ~sw flow in

     

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

     

       180
       180
       +
             let* stdin_data = read_stdin_from_flow ~sw buf_read in

     

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

     

       153
       182
        
             Ok { request with stdin_data }

     

       154
       183
        
         | Filter ->

     

       155
       155
       -
             let* stdin_data = read_stdin_from_flow ~sw flow in

     

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

     

       185
       185
       +
             let* stdin_data = read_stdin_from_flow ~sw buf_read in

     

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

     

       156
       187
        
             let request = { request with stdin_data } in

     

       157
       188
        
             let* data = read_data_from_flow buf_read in

     

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

     

       158
       190
        
             Ok { request with data_stream = Some data }

     

       159
       191
        
       

     

       160
       192
        
       let read_request_from_flow ~sw flow =

     

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

     

       161
       194
        
         let buf_read = Eio.Buf_read.of_flow flow ~max_size:1000000 in

     

       162
       195
        
         try

     

       163
       196
        
           (* Read BEGIN_REQUEST *)

     

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

     

       164
       198
        
           let begin_record = Fastcgi_record.read buf_read in

     

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

     

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

     

       165
       201
        
           let* request = create begin_record in

     

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

     

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

     

       166
       204
        
           (* Read PARAMS stream *)

     

       167
       167
       -
           let* params = read_params_from_flow ~sw flow in

     

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

     

       206
       206
       +
           let* params = read_params_from_flow ~sw buf_read in

     

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

     

       168
       208
        
           let request = { request with params } in

     

       169
       209
        
           (* Read remaining streams based on role *)

     

       170
       170
       -
           read_request_streams ~sw request flow buf_read

     

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

     

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

     

       212
       212
       +
           let result = read_request_streams ~sw request buf_read in

     

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

     

       214
       214
       +
           result

     

       171
       215
        
         with

     

       172
       172
       -
         | End_of_file -> Error "Unexpected end of stream"

     

       173
       173
       -
         | exn -> Error (Printf.sprintf "Error reading request: %s" (Printexc.to_string exn))

     

       216
       216
       +
         | End_of_file -> 

     

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

     

       218
       218
       +
             Error "Unexpected end of stream"

     

       219
       219
       +
         | exn -> 

     

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

     

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

     

       174
       222
        
       

     

       175
       223
        
       (** {1 Response Generation} *)

     

       176
       224

+4 -4

lib/fastcgi_request.mli

···

       43
       43
        
           Returns the populated request context. *)

     

       44
       44
        
       val read_request_from_flow : sw:Eio.Switch.t -> 'a Eio.Flow.source -> (t, string) result

     

       45
       45
        
       

     

       46
       46
       -
       (** [read_params_from_flow ~sw flow] reads PARAMS stream from flow until empty record.

     

       46
       46
       +
       (** [read_params_from_flow ~sw buf_read] reads PARAMS stream from buf_read until empty record.

     

       47
       47
        
           Returns the accumulated parameters. *)

     

       48
       48
       -
       val read_params_from_flow : sw:Eio.Switch.t -> 'a Eio.Flow.source -> (Fastcgi_record.KV.t, string) result

     

       48
       48
       +
       val read_params_from_flow : sw:Eio.Switch.t -> Eio.Buf_read.t -> (Fastcgi_record.KV.t, string) result

     

       49
       49
        
       

     

       50
       50
       -
       (** [read_stdin_from_flow ~sw flow] reads STDIN stream from flow until empty record.

     

       50
       50
       +
       (** [read_stdin_from_flow ~sw buf_read] reads STDIN stream from buf_read until empty record.

     

       51
       51
        
           Returns the accumulated data. *)

     

       52
       52
       -
       val read_stdin_from_flow : sw:Eio.Switch.t -> 'a Eio.Flow.source -> (string, string) result

     

       52
       52
       +
       val read_stdin_from_flow : sw:Eio.Switch.t -> Eio.Buf_read.t -> (string, string) result

     

       53
       53
        
       

     

       54
       54
        
       (** {1 Response Generation} *)

     

       55
       55

test/dune

···

       1
       1
        
       (test

     

       2
       2
        
        (name simple_test)

     

       3
       3
       +
        (modules simple_test)

     

       3
       4
        
        (libraries fastcgi eio eio_main)

     

       4
       5
        
        (deps (source_tree test_cases))

     

       5
       6
        
       )

     

       6
       7
        
       

     

       7
       8
        
       (test

     

       8
       9
        
        (name validate_all_test_cases)

     

       10
       10
       +
        (modules validate_all_test_cases)

     

       9
       11
        
        (libraries fastcgi eio eio_main)

     

       10
       12
        
        (deps (source_tree test_cases))

     

       11
       13
        
       )