From 80e823478f6793476e461690d086c04bb47d429f Mon Sep 17 00:00:00 2001 From: Anurag Soni Date: Mon, 25 Jan 2021 23:57:57 -0500 Subject: [PATCH] try multicore --- src/Tiny_httpd.ml | 13 +++++++++---- src/Tiny_httpd.mli | 2 -- src/dune | 2 +- src/examples/echo.ml | 32 ++++++++++++++++++++++++++++++-- 4 files changed, 40 insertions(+), 9 deletions(-) diff --git a/src/Tiny_httpd.ml b/src/Tiny_httpd.ml index 67311bb4..4cd9f9be 100644 --- a/src/Tiny_httpd.ml +++ b/src/Tiny_httpd.ml @@ -14,7 +14,8 @@ let _enable_debug b = _debug_on := b let _debug k = if !_debug_on then ( k (fun fmt-> - Printf.fprintf stdout "[http.thread %d]: " Thread.(id @@ self()); + let id = (Domain.self () :> int) in + Printf.fprintf stdout "[http.thread %d]: " id; Printf.kfprintf (fun oc -> Printf.fprintf oc "\n%!") stdout fmt) ) @@ -766,7 +767,8 @@ type t = { addr: string; port: int; sem_max_connections: Sem_.t; - new_thread: (unit -> unit) -> unit; + pool: Domainslib.Task.pool; + new_thread: unit Domainslib.Task.task -> unit Domainslib.Task.promise; masksigpipe: bool; mutable handler: (string Request.t -> Response.t); mutable path_handlers : (unit Request.t -> cb_path_handler resp_result option) list; @@ -840,11 +842,14 @@ let add_route_handler_stream ?accept ?meth self route f = let create ?(masksigpipe=true) ?(max_connections=32) - ?(new_thread=(fun f -> ignore (Thread.create f () : Thread.t))) ?(addr="127.0.0.1") ?(port=8080) () : t = let handler _req = Response.fail ~code:404 "no top handler" in + (* TODO: Make pool size configurable, and pick a better heuristic for the pool size. *) + let pool = Domainslib.Task.setup_pool ~num_domains:8 in + let new_thread = fun f -> Domainslib.Task.async pool f in let max_connections = max 4 max_connections in { new_thread; addr; port; masksigpipe; handler; + pool; running= true; sem_max_connections=Sem_.create max_connections; path_handlers=[]; cb_encode_resp=[]; cb_decode_req=[]; @@ -967,7 +972,7 @@ let run (self:t) : (unit,_) result = (try Unix.close client_sock with _ -> ()); Sem_.release 1 self.sem_max_connections; raise e - ); + ) |> ignore done; Ok () with e -> Error e diff --git a/src/Tiny_httpd.mli b/src/Tiny_httpd.mli index 406c7355..4041f330 100644 --- a/src/Tiny_httpd.mli +++ b/src/Tiny_httpd.mli @@ -428,7 +428,6 @@ type t val create : ?masksigpipe:bool -> ?max_connections:int -> - ?new_thread:((unit -> unit) -> unit) -> ?addr:string -> ?port:int -> unit -> @@ -567,4 +566,3 @@ val _debug : ((('a, out_channel, unit, unit, unit, unit) format6 -> 'a) -> unit) val _enable_debug: bool -> unit (**/**) - diff --git a/src/dune b/src/dune index 1ee3eba7..e847d40a 100644 --- a/src/dune +++ b/src/dune @@ -2,7 +2,7 @@ (library (name tiny_httpd) (public_name tiny_httpd) - (libraries threads) + (libraries unix domainslib threads) (inline_tests (backend qtest.lib)) (flags :standard -safe-string) (wrapped false)) diff --git a/src/examples/echo.ml b/src/examples/echo.ml index 3b7c7700..499bfca6 100644 --- a/src/examples/echo.ml +++ b/src/examples/echo.ml @@ -1,6 +1,34 @@ module S = Tiny_httpd +let 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 @@ -14,8 +42,8 @@ let () = Tiny_httpd_camlzip.setup ~compress_above:1024 ~buf_size:(1024*1024) server; (* 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"))); + S.Route.(exact "hello" @/ return) + (fun _req -> S.Response.make_string (Ok text)); S.add_route_handler ~meth:`GET server S.Route.(exact "zcat" @/ string_urlencoded @/ return) (fun path _req ->