diff --git a/src/eio/dune b/src/eio/dune new file mode 100644 index 00000000..5ecf5128 --- /dev/null +++ b/src/eio/dune @@ -0,0 +1,8 @@ + +(library + (name tiny_httpd_eio) + (public_name tiny_httpd_eio) + (synopsis "An EIO-based backend for Tiny_httpd") + (flags :standard -safe-string -warn-error -a+8) + (libraries tiny_httpd eio)) + diff --git a/src/eio/tiny_httpd_eio.ml b/src/eio/tiny_httpd_eio.ml new file mode 100644 index 00000000..25267780 --- /dev/null +++ b/src/eio/tiny_httpd_eio.ml @@ -0,0 +1,134 @@ +module IO = Tiny_httpd_io +module H = Tiny_httpd_server + +let ( let@ ) = ( @@ ) + +type 'a with_args = + ?addr:string -> + ?port:int -> + ?max_connections:int -> + stdenv:Eio.Stdenv.t -> + sw:Eio.Switch.t -> + 'a + +let get_max_connection_ ?(max_connections = 64) () : int = + let max_connections = max 4 max_connections in + max_connections + +let read_buf_size = 4 * 1024 +let write_buf_size = 8 * 1024 + +let ic_of_flow (flow : Eio.Net.stream_socket) : IO.In_channel.t = + let cstruct = Cstruct.create write_buf_size in + let input buf i len = + if len = 0 then + 0 + else ( + let n = flow#read_into (Cstruct.sub cstruct 0 (min len write_buf_size)) in + Cstruct.blit_to_bytes cstruct 0 buf i n; + n + ) + in + let close () = flow#shutdown `Receive in + { IO.In_channel.input; close } + +let oc_of_flow (flow : Eio.Net.stream_socket) : IO.Out_channel.t = + let output buf i len = + if len > 0 then ( + let i = ref i in + let len = ref len in + + let src = + object + inherit Eio.Flow.source + + method read_into (cstruct : Cstruct.t) : int = + if !len = 0 then raise End_of_file; + let n = min !len (Cstruct.length cstruct) in + Cstruct.blit_from_bytes buf !i cstruct 0 n; + i := !i + n; + len := !len - n; + n + end + in + + flow#copy src + ) + in + let close () = flow#shutdown `Send in + let flush () = () in + { IO.Out_channel.close; flush; output } + +let io_backend ?(addr = "127.0.0.1") ?(port = 8080) ?max_connections + ~(stdenv : Eio.Stdenv.t) ~(sw : Eio.Switch.t) () : (module H.IO_BACKEND) = + let module M = struct + let init_addr () = addr + let init_port () = port + + let get_time_s () = + let clock = Eio.Stdenv.clock stdenv in + Eio.Time.now clock + + let spawn f : unit = + Eio.Switch.run @@ fun sub_sw -> Eio.Fiber.fork ~sw:sub_sw f + + let tcp_server () : IO.TCP_server.builder = + { + IO.TCP_server.serve = + (fun ~after_init ~handle () : unit -> + let ip_addr = Eio.Net.Ipaddr.V4.any in + let running = Atomic.make true in + let active_conns = Atomic.make 0 in + + Eio.Switch.on_release sw (fun () -> Atomic.set running false); + let net = Eio.Stdenv.net stdenv in + + (* main server socket *) + let sock = + let backlog = get_max_connection_ ?max_connections () in + Eio.Net.listen ~reuse_addr:true ~reuse_port:true ~backlog ~sw net + (`Tcp (ip_addr, port)) + in + + let tcp_server : IO.TCP_server.t = + { + running = (fun () -> Atomic.get running); + stop = (fun () -> Atomic.set running false); + endpoint = + (fun () -> + (* TODO: find the real port *) + addr, port); + active_connections = (fun () -> Atomic.get active_conns); + } + in + + after_init tcp_server; + + while Atomic.get running do + Eio.Switch.check sw; + + Eio.Net.accept_fork ~sw + ~on_error:(fun exn -> + H._debug (fun k -> + k "error in client handler: %s" (Printexc.to_string exn))) + sock + (fun flow _client_addr -> + Atomic.incr active_conns; + let@ () = + Fun.protect ~finally:(fun () -> + H._debug (fun k -> + k "Tiny_httpd_eio: client handler returned"); + Atomic.decr active_conns) + in + let ic = ic_of_flow flow in + let oc = oc_of_flow flow in + handle.handle ic oc) + done); + } + end in + (module M) + +let create ?addr ?port ?max_connections ~stdenv ~sw ?buf_size ?middlewares () : + H.t = + let backend = io_backend ?addr ?port ?max_connections ~stdenv ~sw () in + H.create_from ?buf_size ?middlewares ~backend () diff --git a/src/eio/tiny_httpd_eio.mli b/src/eio/tiny_httpd_eio.mli new file mode 100644 index 00000000..c79f0525 --- /dev/null +++ b/src/eio/tiny_httpd_eio.mli @@ -0,0 +1,21 @@ +(* TODO: pass in a switch *) + +type 'a with_args = + ?addr:string -> + ?port:int -> + ?max_connections:int -> + stdenv:Eio.Stdenv.t -> + sw:Eio.Switch.t -> + 'a + +val io_backend : (unit -> (module Tiny_httpd_server.IO_BACKEND)) with_args +(** Create a server *) + +val create : + (?buf_size:int -> + ?middlewares: + ([ `Encoding | `Stage of int ] * Tiny_httpd_server.Middleware.t) list -> + unit -> + Tiny_httpd_server.t) + with_args +(** Create a server *) diff --git a/tiny_httpd_eio.opam b/tiny_httpd_eio.opam new file mode 100644 index 00000000..8edeb893 --- /dev/null +++ b/tiny_httpd_eio.opam @@ -0,0 +1,22 @@ +opam-version: "2.0" +version: "0.13" +authors: ["Simon Cruanes"] +maintainer: "simon.cruanes.2007@m4x.org" +license: "MIT" +synopsis: "Run tiny_httpd on Eio" +build: [ + ["dune" "build" "@install" "-p" name "-j" jobs] + ["dune" "build" "@doc" "-p" name] {with-doc} + ["dune" "runtest" "-p" name] {with-test} +] +depends: [ + "dune" { >= "2.0" } + "eio" {>= "0.9"} + "tiny_httpd" { = version } + "odoc" {with-doc} +] +tags: [ "http" "server" "eio" ] +homepage: "https://github.com/c-cube/tiny_httpd/" +doc: "https://c-cube.github.io/tiny_httpd/" +bug-reports: "https://github.com/c-cube/tiny_httpd/issues" +dev-repo: "git+https://github.com/c-cube/tiny_httpd.git"