From c43ffb5ff418037c78194942d85ac0f9224b810c Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 3 Sep 2024 15:16:33 -0400 Subject: [PATCH 1/5] feat: add tiny_httpd_moonpool library --- dune-project | 11 ++ src/moonpool-io/dune | 6 + src/moonpool-io/io_server.ml | 220 +++++++++++++++++++++++++ src/moonpool-io/tiny_httpd_moonpool.ml | 52 ++++++ tiny_httpd_moonpool.opam | 35 ++++ 5 files changed, 324 insertions(+) create mode 100644 src/moonpool-io/dune create mode 100644 src/moonpool-io/io_server.ml create mode 100644 src/moonpool-io/tiny_httpd_moonpool.ml create mode 100644 tiny_httpd_moonpool.opam diff --git a/dune-project b/dune-project index f56ce53f..3eed4894 100644 --- a/dune-project +++ b/dune-project @@ -39,3 +39,14 @@ (iostream-camlzip (>= 0.2.1)) (logs :with-test) (odoc :with-doc))) + +(package + (name tiny_httpd_moonpool) + (synopsis "Moonpool+picos_stdio backend for Tiny_httpd") + (depends + seq + (tiny_httpd (= :version)) + (moonpool (>= 0.7)) + (moonpool-io (>= 0.7)) + (ocaml (>= 5.0)) + (odoc :with-doc))) diff --git a/src/moonpool-io/dune b/src/moonpool-io/dune new file mode 100644 index 00000000..f9880adb --- /dev/null +++ b/src/moonpool-io/dune @@ -0,0 +1,6 @@ + + +(library + (name tiny_httpd_moonpool) + (public_name tiny_httpd_moonpool) + (libraries tiny_httpd moonpool moonpool.sync moonpool.fib moonpool-io)) diff --git a/src/moonpool-io/io_server.ml b/src/moonpool-io/io_server.ml new file mode 100644 index 00000000..362511ba --- /dev/null +++ b/src/moonpool-io/io_server.ml @@ -0,0 +1,220 @@ +open Tiny_httpd_core +module A = Atomic +module MIO = Moonpool_io +module Sem = Moonpool_sync.Semaphore.Counting +module Fd = Moonpool_io.Fd + +module IO_helper = struct + module Slice = Iostream.Slice + + module Output = struct + include IO.Output + + class of_unix_fd ?(close_noerr = false) ~closed ~(buf : Slice.t) (fd : Fd.t) : + t = + object + inherit t_from_output ~bytes:buf.bytes () + + method private output_underlying bs i len0 = + let i = ref i in + let len = ref len0 in + while !len > 0 do + match MIO.Unix.write fd bs !i !len with + | 0 -> failwith "write failed" + | n -> + i := !i + n; + len := !len - n + done + + method private close_underlying () = + if not !closed then ( + closed := true; + if close_noerr then ( + try MIO.Unix.close fd with _ -> () + ) else + MIO.Unix.close fd + ) + end + end + + module Input = struct + include IO.Input + + let of_unix_fd ?(close_noerr = false) ~closed ~(buf : Slice.t) (fd : Fd.t) : + t = + let eof = ref false in + object + inherit Iostream.In_buf.t_from_refill ~bytes:buf.bytes () + + method private refill (slice : Slice.t) = + if not !eof then ( + slice.off <- 0; + let continue = ref true in + while !continue do + match + MIO.Unix.read fd slice.bytes 0 (Bytes.length slice.bytes) + with + | n -> + slice.len <- n; + continue := false + done; + (* Printf.eprintf "read returned %d B\n%!" !n; *) + if slice.len = 0 then eof := true + ) + + method close () = + if not !closed then ( + closed := true; + eof := true; + if close_noerr then ( + try MIO.Unix.close fd with _ -> () + ) else + MIO.Unix.close fd + ) + end + end +end + +open struct + let get_addr_ (fd : Fd.t) = + match Unix.getsockname (Fd.unsafe_get fd) with + | Unix.ADDR_INET (addr, port) -> addr, port + | _ -> invalid_arg "httpd: address is not INET" + + let shutdown_silent_ (fd : Fd.t) : unit = + try MIO.Unix.shutdown fd Unix.SHUTDOWN_ALL with _ -> () + + let close_silent_ (fd : Fd.t) : unit = try MIO.Unix.close fd with _ -> () +end + +type t = { + addr: string; + port: int; + buf_pool: Buf.t Pool.t; + slice_pool: IO.Slice.t Pool.t; + max_connections: int; + sem_max_connections: Sem.t; + (** semaphore to restrict the number of active concurrent connections *) + mutable sock: Fd.t option; (** Socket *) + new_thread: (unit -> unit) -> unit; + timeout: float; + running: bool A.t; (* TODO: use an atomic? *) +} + +let to_tcp_server (self : t) : IO.TCP_server.builder = + { + IO.TCP_server.serve = + (fun ~after_init ~handle () : unit -> + let sock, should_bind = + match self.sock with + | Some s -> + (* Because we're getting a socket from the caller (e.g. systemd) *) + s, false + | None -> + let sock = + Unix.socket + (if Util.is_ipv6_str self.addr then + Unix.PF_INET6 + else + Unix.PF_INET) + Unix.SOCK_STREAM 0 + in + let fd = Fd.create sock in + fd, true (* Because we're creating the socket ourselves *) + in + MIO.Unix.clear_nonblock sock; + MIO.Unix.setsockopt_optint sock Unix.SO_LINGER None; + if should_bind then ( + let inet_addr = Unix.inet_addr_of_string self.addr in + MIO.Unix.setsockopt sock Unix.SO_REUSEADDR true; + MIO.Unix.bind sock (Unix.ADDR_INET (inet_addr, self.port)); + let n_listen = 2 * self.max_connections in + MIO.Unix.listen sock n_listen + ); + + self.sock <- Some sock; + + let tcp_server = + { + IO.TCP_server.stop = (fun () -> Atomic.set self.running false); + running = (fun () -> Atomic.get self.running); + active_connections = + (fun () -> + self.max_connections - Sem.get_value self.sem_max_connections); + endpoint = + (fun () -> + let addr, port = get_addr_ sock in + Unix.string_of_inet_addr addr, port); + } + in + after_init tcp_server; + + (* how to handle a single client *) + let handle_client_ (client_sock : Fd.t) (client_addr : Unix.sockaddr) : + unit = + Log.debug (fun k -> + k "t[%d]: serving new client on %s" + (Thread.id @@ Thread.self ()) + (Util.show_sockaddr client_addr)); + + MIO.Unix.set_nonblock client_sock; + MIO.Unix.setsockopt client_sock Unix.TCP_NODELAY true; + MIO.Unix.(setsockopt_float client_sock SO_RCVTIMEO self.timeout); + MIO.Unix.(setsockopt_float client_sock SO_SNDTIMEO self.timeout); + + Pool.with_resource self.slice_pool @@ fun ic_buf -> + Pool.with_resource self.slice_pool @@ fun oc_buf -> + let closed = ref false in + + let oc = + new IO_helper.Output.of_unix_fd + ~close_noerr:true ~closed ~buf:oc_buf client_sock + in + let ic = + IO_helper.Input.of_unix_fd ~close_noerr:true ~closed ~buf:ic_buf + client_sock + in + handle.handle ~client_addr ic oc + in + + MIO.Unix.set_nonblock sock; + while Atomic.get self.running do + match MIO.Unix.accept sock with + | client_sock, client_addr -> + (* limit concurrency *) + Sem.acquire self.sem_max_connections; + self.new_thread (fun () -> + try + handle_client_ client_sock client_addr; + Log.debug (fun k -> + k "t[%d]: done with client on %s, exiting" + (Thread.id @@ Thread.self ()) + @@ Util.show_sockaddr client_addr); + shutdown_silent_ client_sock; + close_silent_ client_sock; + Sem.release self.sem_max_connections + with e -> + let bt = Printexc.get_raw_backtrace () in + shutdown_silent_ client_sock; + close_silent_ client_sock; + Sem.release self.sem_max_connections; + Log.error (fun k -> + k + "@[Handler: uncaught exception for client %s:@ %s@ \ + %s@]" + (Util.show_sockaddr client_addr) + (Printexc.to_string e) + (Printexc.raw_backtrace_to_string bt))) + | exception e -> + Log.error (fun k -> + k "Unix.accept raised an exception: %s" (Printexc.to_string e)); + Atomic.set self.running false + done; + + (* Wait for all threads to be done: this only works if all threads are done. *) + MIO.Unix.close sock; + while Sem.get_value self.sem_max_connections < self.max_connections do + Sem.acquire self.sem_max_connections + done; + ()); + } diff --git a/src/moonpool-io/tiny_httpd_moonpool.ml b/src/moonpool-io/tiny_httpd_moonpool.ml new file mode 100644 index 00000000..e432ccec --- /dev/null +++ b/src/moonpool-io/tiny_httpd_moonpool.ml @@ -0,0 +1,52 @@ +include Tiny_httpd +module Fd = Io_server.Fd + +open struct + let get_max_connection_ ?(max_connections = 64) () : int = + let max_connections = max 4 max_connections in + max_connections + + let clear_slice (slice : IO.Slice.t) = + Bytes.fill slice.bytes 0 (Bytes.length slice.bytes) '\x00'; + slice.off <- 0; + slice.len <- 0 +end + +let create ?max_connections ?(timeout = 0.0) ?buf_size + ?(get_time_s = Unix.gettimeofday) ?(addr = "127.0.0.1") ?(port = 8080) + ?(sock : Fd.t option) ?middlewares ~(runner : Moonpool.Runner.t) () : t = + let new_thread f = + ignore (Moonpool_fib.spawn_top ~on:runner f : _ Moonpool_fib.t) + in + let max_connections = get_max_connection_ ?max_connections () in + let server = + { + Io_server.addr; + new_thread; + buf_pool = + Pool.create ~clear:Buf.clear_and_zero + ~mk_item:(fun () -> Buf.create ?size:buf_size ()) + (); + slice_pool = + Pool.create ~clear:clear_slice + ~mk_item: + (let buf_size = Option.value buf_size ~default:4096 in + fun () -> IO.Slice.create buf_size) + (); + running = Atomic.make true; + port; + sock; + max_connections; + sem_max_connections = Io_server.Sem.make max_connections; + timeout; + } + in + let tcp_server_builder = Io_server.to_tcp_server server in + let module B = struct + let init_addr () = addr + let init_port () = port + let get_time_s = get_time_s + let tcp_server () = tcp_server_builder + end in + let backend = (module B : IO_BACKEND) in + Server.create_from ?buf_size ?middlewares ~backend () diff --git a/tiny_httpd_moonpool.opam b/tiny_httpd_moonpool.opam new file mode 100644 index 00000000..b067b7d8 --- /dev/null +++ b/tiny_httpd_moonpool.opam @@ -0,0 +1,35 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +version: "0.17" +synopsis: "Moonpool+picos_stdio backend for Tiny_httpd" +maintainer: ["c-cube"] +authors: ["c-cube"] +license: "MIT" +homepage: "https://github.com/c-cube/tiny_httpd/" +bug-reports: "https://github.com/c-cube/tiny_httpd/issues" +depends: [ + "dune" {>= "2.9"} + "seq" + "tiny_httpd" {= version} + "moonpool" {>= "0.7"} + "moonpool-io" {>= "0.7"} + "ocaml" {>= "5.0"} + "odoc" {with-doc} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "--promote-install-files=false" + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] + ["dune" "install" "-p" name "--create-install-files" name] +] +dev-repo: "git+https://github.com/c-cube/tiny_httpd.git" From cf9c14b1c2f69435c331954e80f6a163140ee33f Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 3 Sep 2024 15:16:52 -0400 Subject: [PATCH 2/5] basic test for moonpool-io --- examples/dune | 6 + examples/echo_mio.ml | 282 +++++++++++++++++++++++++++++++++++++++++ tests/dune | 21 +++ tests/echo_mio1.expect | 10 ++ tests/echo_mio1.sh | 12 ++ 5 files changed, 331 insertions(+) create mode 100644 examples/echo_mio.ml create mode 100644 tests/echo_mio1.expect create mode 100755 tests/echo_mio1.sh diff --git a/examples/dune b/examples/dune index d2c19915..bbf5d101 100644 --- a/examples/dune +++ b/examples/dune @@ -14,6 +14,12 @@ (modules echo vfs) (libraries tiny_httpd logs tiny_httpd_camlzip)) +(executable + (name echo_mio) + (flags :standard -warn-error -a+8) + (modules echo_mio) + (libraries tiny_httpd tiny_httpd_moonpool logs)) + (executable (name writer) (flags :standard -warn-error -a+8) diff --git a/examples/echo_mio.ml b/examples/echo_mio.ml new file mode 100644 index 00000000..643b4173 --- /dev/null +++ b/examples/echo_mio.ml @@ -0,0 +1,282 @@ +open Tiny_httpd_core +module Log = Tiny_httpd.Log + +let now_ = Unix.gettimeofday + +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......" + +(* util: a little middleware collecting statistics *) +let middleware_stat () : Server.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 = 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 + +(* ugly AF *) +let base64 x = + let ic, oc = Unix.open_process "base64" in + output_string oc x; + flush oc; + close_out oc; + let r = input_line ic in + ignore (Unix.close_process (ic, oc)); + r + +let setup_logging () = + Logs.set_reporter @@ Logs.format_reporter (); + Logs.set_level ~all:true (Some Logs.Debug) + +let () = + Moonpool_fib.main @@ fun _ -> + let port_ = ref 8080 in + let max_conn = ref 800 in + let j = ref 16 in + Arg.parse + (Arg.align + [ + "--port", Arg.Set_int port_, " set port"; + "-p", Arg.Set_int port_, " set port"; + "--debug", Arg.Unit setup_logging, " enable debug"; + ( "--max-connections", + Arg.Set_int max_conn, + " maximum number of connections" ); + "-j", Arg.Set_int j, " Size of thread pool"; + ]) + (fun _ -> raise (Arg.Bad "")) + "echo [option]*"; + + let runner = Moonpool.Ws_pool.create ~num_threads:!j () in + let server : Server.t = + Tiny_httpd_moonpool.create ~runner ~port:!port_ ~max_connections:!max_conn + () + in + + let m_stats, get_stats = middleware_stat () in + Server.add_middleware server ~stage:(`Stage 1) m_stats; + + (* say hello *) + Server.add_route_handler ~meth:`GET server + Route.(exact "hello" @/ string @/ return) + (fun name _req -> Response.make_string (Ok ("hello " ^ name ^ "!\n"))); + + (* compressed file access *) + Server.add_route_handler ~meth:`GET server + Route.(exact "zcat" @/ string_urlencoded @/ return) + (fun path _req -> + let ic = open_in path in + let str = IO.Input.of_in_channel 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 + Response.make_stream ~headers:mime_type (Ok str)); + + (* echo request *) + Server.add_route_handler server + Route.(exact "echo" @/ return) + (fun req -> + let q = + Request.query req + |> List.map (fun (k, v) -> Printf.sprintf "%S = %S" k v) + |> String.concat ";" + in + Response.make_string + (Ok (Format.asprintf "echo:@ %a@ (query: %s)@." Request.pp req q))); + + (* file upload *) + Server.add_route_handler_stream ~meth:`PUT server + Route.(exact "upload" @/ string @/ return) + (fun path req -> + Log.debug (fun k -> + k "start upload %S, headers:\n%s\n\n%!" path + (Format.asprintf "%a" Headers.pp (Request.headers req))); + try + let oc = open_out @@ "/tmp/" ^ path in + IO.Input.to_chan oc req.Request.body; + flush oc; + Response.make_string (Ok "uploaded file") + with e -> + Response.fail ~code:500 "couldn't upload file: %s" + (Printexc.to_string e)); + + (* protected by login *) + Server.add_route_handler server + Route.(exact "protected" @/ return) + (fun req -> + let ok = + match Request.get_header req "authorization" with + | Some v -> + Log.debug (fun k -> k "authenticate with %S" v); + v = "Basic " ^ base64 "user:foobar" + | None -> false + in + if ok then ( + (* FIXME: a logout link *) + let s = + "

hello, this is super secret!

log out" + in + Response.make_string (Ok s) + ) else ( + let headers = + Headers.(empty |> set "www-authenticate" "basic realm=\"echo\"") + in + Response.fail ~code:401 ~headers "invalid" + )); + + (* logout *) + Server.add_route_handler server + Route.(exact "logout" @/ return) + (fun _req -> Response.fail ~code:401 "logged out"); + + (* stats *) + Server.add_route_handler server + Route.(exact "stats" @/ return) + (fun _req -> + let stats = get_stats () in + Response.make_string @@ Ok stats); + + Server.add_route_handler server + Route.(exact "alice" @/ return) + (fun _req -> Response.make_string (Ok alice_text)); + + (* main page *) + Server.add_route_handler server + 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 [ A.href "/protected" ] [ txt "/protected" ]; + txt + " (GET) to see a protected page (login: user, \ + password: foobar)"; + ]; + ]; + li [] + [ + pre [] + [ + a [ A.href "/logout" ] [ txt "/logout" ]; + txt " (POST) to log out"; + ]; + ]; + ]; + ]; + ] + in + let s = to_string_top h in + Response.make_string ~headers:[ "content-type", "text/html" ] @@ Ok s); + + Printf.printf "listening on http://%s:%d\n%!" (Server.addr server) + (Server.port server); + match Server.run server with + | Ok () -> () + | Error e -> raise e diff --git a/tests/dune b/tests/dune index 4725b595..5f9097d7 100644 --- a/tests/dune +++ b/tests/dune @@ -19,6 +19,27 @@ (action (diff echo1.expect echo1.out))) +(rule + (targets echo_mio1.out) + (deps + (:bin ../examples/echo_mio.exe)) + (locks /port) + (enabled_if + (= %{system} "linux")) + (package tiny_httpd_moonpool) + (action + (with-stdout-to + %{targets} + (run ./echo_mio1.sh %{bin})))) + +(rule + (alias runtest) + (package tiny_httpd_moonpool) + (enabled_if + (= %{system} "linux")) + (action + (diff echo_mio1.expect echo_mio1.out))) + (rule (targets sse_count.out) (deps diff --git a/tests/echo_mio1.expect b/tests/echo_mio1.expect new file mode 100644 index 00000000..cb100327 --- /dev/null +++ b/tests/echo_mio1.expect @@ -0,0 +1,10 @@ +listening on http://127.0.0.1:8085 +test moonpool_io +echo: +{meth=GET; host=localhost:8085; + headers=[user-agent: test + accept: */* + host: localhost:8085]; + path="/echo/?a=b&c=d"; body=""; path_components=["echo"]; + query=["c","d";"a","b"]} +(query: "c" = "d";"a" = "b") diff --git a/tests/echo_mio1.sh b/tests/echo_mio1.sh new file mode 100755 index 00000000..4e9ec3ce --- /dev/null +++ b/tests/echo_mio1.sh @@ -0,0 +1,12 @@ +#!/usr/bin/env sh + +ECHO=$1 +PORT=8085 + +"$ECHO" -p $PORT & +PID=$! +sleep 0.1 +echo "test moonpool_io" +curl -N "http://localhost:${PORT}/echo/?a=b&c=d" -H user-agent:test --max-time 5 + +kill $PID From e199162e1f52ad7431596d3503b6742d7308dda6 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 3 Sep 2024 15:40:26 -0400 Subject: [PATCH 3/5] fix: also make server socket nonblocking --- src/moonpool-io/io_server.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/moonpool-io/io_server.ml b/src/moonpool-io/io_server.ml index 362511ba..d26a1e07 100644 --- a/src/moonpool-io/io_server.ml +++ b/src/moonpool-io/io_server.ml @@ -122,7 +122,7 @@ let to_tcp_server (self : t) : IO.TCP_server.builder = let fd = Fd.create sock in fd, true (* Because we're creating the socket ourselves *) in - MIO.Unix.clear_nonblock sock; + MIO.Unix.set_nonblock sock; MIO.Unix.setsockopt_optint sock Unix.SO_LINGER None; if should_bind then ( let inet_addr = Unix.inet_addr_of_string self.addr in From 7f9fae1fc86b402f8a4877355577fcf39e6d1cda Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 3 Sep 2024 15:51:15 -0400 Subject: [PATCH 4/5] test: echo_mio: add a heavier endpoint --- examples/echo_mio.ml | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/examples/echo_mio.ml b/examples/echo_mio.ml index 643b4173..962fa4e1 100644 --- a/examples/echo_mio.ml +++ b/examples/echo_mio.ml @@ -199,6 +199,18 @@ let () = Route.(exact "alice" @/ return) (fun _req -> Response.make_string (Ok alice_text)); + Server.add_route_handler server + Route.(exact "alice10" @/ return) + (fun _req -> + let writer = + IO.Writer.make () ~write:(fun oc -> + for _i = 1 to 10 do + IO.Output.output_string oc alice_text; + IO.Output.flush oc + done) + in + Response.make_writer (Ok writer)); + (* main page *) Server.add_route_handler server Route.(return) From a56dd0ec65fb3a099aeb613f6c5fa180fb4595a7 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 6 Sep 2024 17:19:56 -0400 Subject: [PATCH 5/5] add echo_mio.sh --- echo_mio.sh | 2 ++ 1 file changed, 2 insertions(+) create mode 100755 echo_mio.sh diff --git a/echo_mio.sh b/echo_mio.sh new file mode 100755 index 00000000..e18dcb6e --- /dev/null +++ b/echo_mio.sh @@ -0,0 +1,2 @@ +#!/bin/sh +exec dune exec --display=quiet --profile=release "examples/echo_mio.exe" -- $@