diff --git a/echo_eio.sh b/echo_eio.sh deleted file mode 100755 index 5621bddc..00000000 --- a/echo_eio.sh +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/sh -exec dune exec --display=quiet --profile=release "examples/echo_eio.exe" -- $@ diff --git a/examples/dune b/examples/dune index dd8e19a3..9f5603b2 100644 --- a/examples/dune +++ b/examples/dune @@ -14,13 +14,6 @@ (modules echo vfs) (libraries tiny_httpd tiny_httpd_camlzip)) -(executable - (name echo_eio) - (flags :standard -warn-error -a+8) - (modules echo_eio) - (libraries tiny_httpd tiny_httpd_camlzip - tiny_httpd_eio eio eio_posix)) - (executable (name writer) (flags :standard -warn-error -a+8) diff --git a/examples/echo_eio.ml b/examples/echo_eio.ml deleted file mode 100644 index 39244a93..00000000 --- a/examples/echo_eio.ml +++ /dev/null @@ -1,246 +0,0 @@ -module S = Tiny_httpd -module S_eio = Tiny_httpd_eio - -let now_ = Unix.gettimeofday -let ( let@ ) = ( @@ ) - -(* util: a little middleware collecting statistics *) -let middleware_stat () : S.Middleware.t * (unit -> string) = - let n_req = ref 0 in - let total_time_ = ref 0. in - let parse_time_ = ref 0. in - let build_time_ = ref 0. in - let write_time_ = ref 0. in - - let m h req ~resp = - incr n_req; - let t1 = S.Request.start_time req in - let t2 = now_ () in - h req ~resp:(fun response -> - let t3 = now_ () in - resp response; - let t4 = now_ () in - total_time_ := !total_time_ +. (t4 -. t1); - parse_time_ := !parse_time_ +. (t2 -. t1); - build_time_ := !build_time_ +. (t3 -. t2); - write_time_ := !write_time_ +. (t4 -. t3)) - and get_stat () = - Printf.sprintf - "%d requests (average response time: %.3fms = %.3fms + %.3fms + %.3fms)" - !n_req - (!total_time_ /. float !n_req *. 1e3) - (!parse_time_ /. float !n_req *. 1e3) - (!build_time_ /. float !n_req *. 1e3) - (!write_time_ /. float !n_req *. 1e3) - in - m, get_stat - -let alice_text = - "CHAPTER I. Down the Rabbit-Hole Alice was beginning to get very tired of \ - sitting by her sister on the bank, and of having nothing to do: once or \ - twice she had peeped into the book her sister was reading, but it had no \ - pictures or conversations in it, thought \ - Alice So she was considering in her \ - own mind (as well as she could, for the hot day made her feel very sleepy \ - and stupid), whether the pleasure of making a daisy-chain would be worth \ - the trouble of getting up and picking the daisies, when suddenly a White \ - Rabbit with pink eyes ran close by her. There was nothing so very \ - remarkable in that; nor did Alice think it so very much out of the way to \ - hear the Rabbit say to itself, (when \ - she thought it over afterwards, it occurred to her that she ought to have \ - wondered at this, but at the time it all seemed quite natural); but when \ - the Rabbit actually took a watch out of its waistcoat-pocket, and looked at \ - it, and then hurried on, Alice started to her feet, for it flashed across \ - her mind that she had never before seen a rabbit with either a \ - waistcoat-pocket, or a watch to take out of it, and burning with curiosity, \ - she ran across the field after it, and fortunately was just in time to see \ - it pop down a large rabbit-hole under the hedge. In another moment down \ - went Alice after it, never once considering how in the world she was to get \ - out again. The rabbit-hole went straight on like a tunnel for some way, and \ - then dipped suddenly down, so suddenly that Alice had not a moment to think \ - about stopping herself before she found herself falling down a very deep \ - well. Either the well was very deep, or she fell very slowly, for she had \ - plenty of time as she went down to look about her and to wonder what was \ - going to happen next. First, she tried to look down and make out what she \ - was coming to, but it was too dark to see anything; then she looked at the \ - sides of the well, and noticed that they were filled with cupboards......" - -let () = - let port_ = ref 8080 in - let j = ref 32 in - Arg.parse - (Arg.align - [ - "--port", Arg.Set_int port_, " set port"; - "-p", Arg.Set_int port_, " set port"; - "--debug", Arg.Unit (fun () -> S._enable_debug true), " enable debug"; - "-j", Arg.Set_int j, " maximum number of connections"; - ]) - (fun _ -> raise (Arg.Bad "")) - "echo [option]*"; - - (* use eio *) - let@ stdenv = Eio_posix.run in - let@ sw = Eio.Switch.run in - - (* create server *) - let server : S.t = - S_eio.create ~port:!port_ ~max_connections:!j - ~stdenv:(stdenv :> Eio_unix.Stdenv.base) - ~sw () - in - - Tiny_httpd_camlzip.setup ~compress_above:1024 ~buf_size:(16 * 1024) server; - let m_stats, get_stats = middleware_stat () in - S.add_middleware server ~stage:(`Stage 1) m_stats; - - (* say hello *) - S.add_route_handler ~meth:`GET server - S.Route.(exact "hello" @/ string @/ return) - (fun name _req -> S.Response.make_string (Ok ("hello " ^ name ^ "!\n"))); - - (* compressed file access *) - S.add_route_handler ~meth:`GET server - S.Route.(exact "zcat" @/ string_urlencoded @/ return) - (fun path _req -> - let ic = open_in path in - let str = S.Byte_stream.of_chan ic in - let mime_type = - try - let p = Unix.open_process_in (Printf.sprintf "file -i -b %S" path) in - try - let s = [ "Content-Type", String.trim (input_line p) ] in - ignore @@ Unix.close_process_in p; - s - with _ -> - ignore @@ Unix.close_process_in p; - [] - with _ -> [] - in - S.Response.make_stream ~headers:mime_type (Ok str)); - - (* echo request *) - S.add_route_handler server - S.Route.(exact "echo" @/ return) - (fun req -> - let q = - S.Request.query req - |> List.map (fun (k, v) -> Printf.sprintf "%S = %S" k v) - |> String.concat ";" - in - S.Response.make_string - (Ok (Format.asprintf "echo:@ %a@ (query: %s)@." S.Request.pp req q))); - - (* file upload *) - S.add_route_handler_stream ~meth:`PUT server - S.Route.(exact "upload" @/ string @/ return) - (fun path req -> - S._debug (fun k -> - k "start upload %S, headers:\n%s\n\n%!" path - (Format.asprintf "%a" S.Headers.pp (S.Request.headers req))); - try - let oc = open_out @@ "/tmp/" ^ path in - S.Byte_stream.to_chan oc req.S.Request.body; - flush oc; - S.Response.make_string (Ok "uploaded file") - with e -> - S.Response.fail ~code:500 "couldn't upload file: %s" - (Printexc.to_string e)); - - (* stats *) - S.add_route_handler server - S.Route.(exact "stats" @/ return) - (fun _req -> - let stats = get_stats () in - S.Response.make_string @@ Ok stats); - - S.add_route_handler server ~meth:`POST - S.Route.(exact "quit" @/ return) - (fun _req -> - S.stop server; - S.Response.make_string (Ok "quitting")); - - S.add_route_handler server - S.Route.(exact "alice" @/ return) - (fun _req -> S.Response.make_string (Ok alice_text)); - - (* main page *) - S.add_route_handler server - S.Route.(return) - (fun _req -> - let open Tiny_httpd_html in - let h = - html [] - [ - head [] [ title [] [ txt "index of echo" ] ]; - body [] - [ - h3 [] [ txt "welcome!" ]; - p [] [ b [] [ txt "endpoints are:" ] ]; - ul [] - [ - li [] [ pre [] [ txt "/hello/:name (GET)" ] ]; - li [] - [ - pre [] - [ - a [ A.href "/echo/" ] [ txt "echo" ]; - txt " echo back query"; - ]; - ]; - li [] - [ pre [] [ txt "/upload/:path (PUT) to upload a file" ] ]; - li [] - [ - pre [] - [ - txt - "/zcat/:path (GET) to download a file (deflate \ - transfer-encoding)"; - ]; - ]; - li [] - [ - pre [] - [ - a [ A.href "/stats/" ] [ txt "/stats/" ]; - txt " (GET) to access statistics"; - ]; - ]; - li [] - [ - pre [] - [ - a [ A.href "/vfs/" ] [ txt "/vfs" ]; - txt " (GET) to access a VFS embedded in the binary"; - ]; - ]; - li [] - [ - pre - [ A.style "display: inline" ] - [ - a [ A.href "/quit" ] [ txt "/quit" ]; - txt " (POST) to stop server"; - ]; - form - [ - A.style "display: inline"; - A.action "/quit"; - A.method_ "POST"; - ] - [ button [ A.type_ "submit" ] [ txt "quit" ] ]; - ]; - ]; - ]; - ] - in - let s = to_string_top h in - S.Response.make_string ~headers:[ "content-type", "text/html" ] @@ Ok s); - - Printf.printf "listening on http://%s:%d\n%!" (S.addr server) (S.port server); - let res = S.run server in - Gc.print_stat stdout; - match res with - | Ok () -> () - | Error e -> raise e diff --git a/src/eio/dune b/src/eio/dune deleted file mode 100644 index 37431aba..00000000 --- a/src/eio/dune +++ /dev/null @@ -1,8 +0,0 @@ - -(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 eio.unix)) - diff --git a/src/eio/tiny_httpd_eio.ml b/src/eio/tiny_httpd_eio.ml deleted file mode 100644 index 47bf3727..00000000 --- a/src/eio/tiny_httpd_eio.ml +++ /dev/null @@ -1,178 +0,0 @@ -module IO = Tiny_httpd_io -module H = Tiny_httpd_server -module Pool = Tiny_httpd_pool - -let ( let@ ) = ( @@ ) - -type 'a with_args = - ?addr:string -> - ?port:int -> - ?max_connections:int -> - stdenv:Eio_unix.Stdenv.base -> - sw:Eio.Switch.t -> - 'a - -let get_max_connection_ ?(max_connections = 64) () : int = - let max_connections = max 4 max_connections in - max_connections - -let buf_size = 16 * 1024 - -let ic_of_flow ~buf_pool:ic_pool (flow : Eio.Net.stream_socket) : - IO.In_channel.t = - Pool.with_resource ic_pool @@ fun cstruct -> - let len_slice = ref 0 in - let offset = ref 0 in - - let input buf i len = - if len = 0 then - 0 - else ( - let available = ref (!len_slice - !offset) in - if !available = 0 then ( - let n = flow#read_into cstruct in - offset := 0; - len_slice := n; - available := n - ); - - let n = min !available len in - if n > 0 then ( - Cstruct.blit_to_bytes cstruct !offset buf i n; - offset := !offset + n; - n - ) else - 0 - ) - in - let close () = flow#shutdown `Receive in - { IO.In_channel.input; close } - -let oc_of_flow ~buf_pool:oc_pool (flow : Eio.Net.stream_socket) : - IO.Out_channel.t = - (* write buffer *) - Pool.with_resource oc_pool @@ fun wbuf -> - let offset = ref 0 in - - let flush () = - if !offset > 0 then ( - let i = ref 0 in - let len = ref !offset 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 wbuf !i cstruct 0 n; - i := !i + n; - len := !len - n; - n - end - in - - flow#copy src; - offset := 0 - ) - in - - let output buf i len = - let i = ref i in - let len = ref len in - - while !len > 0 do - let available = Bytes.length wbuf - !offset in - let n = min !len available in - Bytes.blit buf !i wbuf !offset n; - offset := !offset + n; - i := !i + n; - len := !len - n; - - if !offset = Bytes.length wbuf then flush () - done - in - - let output_char c = - if !offset = Bytes.length wbuf then flush (); - Bytes.set wbuf !offset c; - incr offset; - if !offset = Bytes.length wbuf then flush () - in - - let close () = flow#shutdown `Send in - { IO.Out_channel.close; flush; output; output_char } - -let io_backend ?(addr = "127.0.0.1") ?(port = 8080) ?max_connections - ~(stdenv : Eio_unix.Stdenv.base) ~(sw : Eio.Switch.t) () : - (module H.IO_BACKEND) = - let module M = struct - let init_addr () = addr - let init_port () = port - let get_time_s () = Unix.gettimeofday () - let ic_pool = Pool.create ~mk_item:(fun () -> Cstruct.create buf_size) () - let oc_pool = Pool.create ~mk_item:(fun () -> Bytes.create buf_size) () - - let tcp_server () : IO.TCP_server.builder = - { - IO.TCP_server.serve = - (fun ~after_init ~handle () : unit -> - (* FIXME: parse *) - 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; - Eio.Switch.fail sw Exit); - 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.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 ~buf_pool:ic_pool flow in - let oc = oc_of_flow ~buf_pool:oc_pool 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 deleted file mode 100644 index 251f9508..00000000 --- a/src/eio/tiny_httpd_eio.mli +++ /dev/null @@ -1,30 +0,0 @@ -(** Tiny httpd EIO backend. - - This replaces the threads + Unix blocking syscalls of {!Tiny_httpd_server} - with an Eio-based cooperative system. - - {b NOTE}: this is very experimental and will absolutely change over time, - especially since Eio itself is also subject to change. - @since NEXT_RELEASE *) - -(* TODO: pass in a switch *) - -type 'a with_args = - ?addr:string -> - ?port:int -> - ?max_connections:int -> - stdenv:Eio_unix.Stdenv.base -> - 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 deleted file mode 100644 index 8edeb893..00000000 --- a/tiny_httpd_eio.opam +++ /dev/null @@ -1,22 +0,0 @@ -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"