mirror of
https://github.com/c-cube/moonpool.git
synced 2025-12-07 03:35:36 -05:00
rename moonpool-unix to moonpool-io, will use poll
This commit is contained in:
Simon Cruanes
parent
879d380faf
commit
d3188a95b9
7 changed files with 7 additions and 244 deletions
|
|
@ -34,11 +34,12 @@
|
||||||
(thread pool domain futures fork-join)))
|
(thread pool domain futures fork-join)))
|
||||||
|
|
||||||
(package
|
(package
|
||||||
(name moonpool-unix)
|
(name moonpool-io)
|
||||||
(synopsis "Non blocking IO for Moonpool based on Unix")
|
(synopsis "Non blocking IO for Moonpool based on Unix")
|
||||||
(depends
|
(depends
|
||||||
(ocaml (>= 5.0))
|
(ocaml (>= 5.0))
|
||||||
dune
|
dune
|
||||||
|
(poll (and (>= 3.0) (< 4.0)))
|
||||||
(iostream (>= 0.2.2))
|
(iostream (>= 0.2.2))
|
||||||
(trace :with-test))
|
(trace :with-test))
|
||||||
(depopts
|
(depopts
|
||||||
|
|
|
||||||
|
|
@ -11,6 +11,7 @@ bug-reports: "https://github.com/c-cube/moonpool/issues"
|
||||||
depends: [
|
depends: [
|
||||||
"ocaml" {>= "5.0"}
|
"ocaml" {>= "5.0"}
|
||||||
"dune" {>= "3.0"}
|
"dune" {>= "3.0"}
|
||||||
|
"poll" {>= "3.0" & < "4.0"}
|
||||||
"iostream" {>= "0.2.2"}
|
"iostream" {>= "0.2.2"}
|
||||||
"trace" {with-test}
|
"trace" {with-test}
|
||||||
"odoc" {with-doc}
|
"odoc" {with-doc}
|
||||||
|
|
@ -1,11 +1,12 @@
|
||||||
(library
|
(library
|
||||||
(name moonpool_unix)
|
(name moonpool_io)
|
||||||
(public_name moonpool-unix)
|
(public_name moonpool-io)
|
||||||
(synopsis "Simple Unix-based event loop for moonpool")
|
(synopsis "Async IOs for moonpool")
|
||||||
(private_modules common_ heap_)
|
(private_modules common_ heap_)
|
||||||
(libraries
|
(libraries
|
||||||
moonpool
|
moonpool
|
||||||
moonpool.fib
|
moonpool.fib
|
||||||
|
(re_export poll)
|
||||||
unix
|
unix
|
||||||
iostream
|
iostream
|
||||||
(re_export iostream.types)
|
(re_export iostream.types)
|
||||||
|
|
|
||||||
|
|
@ -1,20 +0,0 @@
|
||||||
(** {2 Re-exports} *)
|
|
||||||
|
|
||||||
module Exn_bt = Moonpool.Exn_bt
|
|
||||||
module Fiber = Moonpool_fib.Fiber
|
|
||||||
module FLS = Moonpool_fib.Fls
|
|
||||||
module Runner = Moonpool.Runner
|
|
||||||
module Ws_pool = Moonpool.Ws_pool
|
|
||||||
module Fifo_pool = Moonpool.Fifo_pool
|
|
||||||
module Fut = Moonpool.Fut
|
|
||||||
|
|
||||||
(** {2 Event loop modules} *)
|
|
||||||
|
|
||||||
module Fd = Fd
|
|
||||||
module Cancel_handle = Cancel_handle
|
|
||||||
module Sockaddr = Sockaddr
|
|
||||||
include Async_io
|
|
||||||
|
|
||||||
let run_after_s = Ev_loop.run_after_s
|
|
||||||
let run_every_s = Ev_loop.run_every_s
|
|
||||||
let main = Moonpool_fib.main
|
|
||||||
|
|
@ -1,4 +0,0 @@
|
||||||
(executables
|
|
||||||
(names t_hash echo_server)
|
|
||||||
;(package moonpool-unix)
|
|
||||||
(libraries moonpool moonpool-unix trace.core trace-tef))
|
|
||||||
|
|
@ -1,62 +0,0 @@
|
||||||
module M = Moonpool
|
|
||||||
module MU = Moonpool_unix
|
|
||||||
module Trace = Trace_core
|
|
||||||
|
|
||||||
let ( let@ ) = ( @@ )
|
|
||||||
|
|
||||||
let main ~port ~j () : unit =
|
|
||||||
let@ _sp = Trace.with_span ~__FILE__ ~__LINE__ "main" in
|
|
||||||
let@ runner = M.Ws_pool.with_ ~name:"tpool" ~num_threads:j () in
|
|
||||||
|
|
||||||
let@ _main_runner = MU.main in
|
|
||||||
Trace.set_thread_name "main";
|
|
||||||
|
|
||||||
let@ server =
|
|
||||||
MU.TCP_server.with_server ~runner (MU.Sockaddr.any port)
|
|
||||||
~handle:(fun ~client_addr:addr ic oc ->
|
|
||||||
Trace.message "got new client";
|
|
||||||
let@ _sp =
|
|
||||||
Trace.with_span ~__FILE__ ~__LINE__ "handle.client" ~data:(fun () ->
|
|
||||||
[ "addr", `String (MU.Sockaddr.show addr) ])
|
|
||||||
in
|
|
||||||
|
|
||||||
let buf = Bytes.create 32 in
|
|
||||||
let continue = ref true in
|
|
||||||
while !continue do
|
|
||||||
Trace.message "read";
|
|
||||||
let n = Iostream.In_buf.input ic buf 0 (Bytes.length buf) in
|
|
||||||
if n = 0 then continue := false;
|
|
||||||
Trace.messagef (fun k -> k "got %dB" n);
|
|
||||||
Iostream.Out_buf.output oc buf 0 n;
|
|
||||||
Iostream.Out_buf.flush oc;
|
|
||||||
Trace.message "write"
|
|
||||||
(* MU.sleep_s 0.02 *)
|
|
||||||
done)
|
|
||||||
in
|
|
||||||
|
|
||||||
Trace.messagef (fun k ->
|
|
||||||
k "server established on %s"
|
|
||||||
(MU.Sockaddr.show @@ MU.TCP_server.endpoint server));
|
|
||||||
Printf.printf "listening on %s\n%!"
|
|
||||||
(MU.Sockaddr.show @@ MU.TCP_server.endpoint server);
|
|
||||||
|
|
||||||
Trace.message "awaiting server";
|
|
||||||
MU.TCP_server.await server;
|
|
||||||
()
|
|
||||||
|
|
||||||
let () =
|
|
||||||
Sys.catch_break true;
|
|
||||||
let@ () = Trace_tef.with_setup () in
|
|
||||||
Trace.set_thread_name "entry";
|
|
||||||
let port = ref 0 in
|
|
||||||
let j = ref 4 in
|
|
||||||
|
|
||||||
let opts =
|
|
||||||
[
|
|
||||||
"-p", Arg.Set_int port, " port"; "j", Arg.Set_int j, " number of threads";
|
|
||||||
]
|
|
||||||
|> Arg.align
|
|
||||||
in
|
|
||||||
Arg.parse opts ignore "echo server";
|
|
||||||
|
|
||||||
main ~port:!port ~j:!j ()
|
|
||||||
|
|
@ -1,154 +0,0 @@
|
||||||
(* vendored from https://github.com/dbuenzli/uuidm *)
|
|
||||||
|
|
||||||
let sha_1 s =
|
|
||||||
(* Based on pseudo-code of RFC 3174. Slow and ugly but does the job. *)
|
|
||||||
let sha_1_pad s =
|
|
||||||
let len = String.length s in
|
|
||||||
let blen = 8 * len in
|
|
||||||
let rem = len mod 64 in
|
|
||||||
let mlen =
|
|
||||||
if rem > 55 then
|
|
||||||
len + 128 - rem
|
|
||||||
else
|
|
||||||
len + 64 - rem
|
|
||||||
in
|
|
||||||
let m = Bytes.create mlen in
|
|
||||||
Bytes.blit_string s 0 m 0 len;
|
|
||||||
Bytes.fill m len (mlen - len) '\x00';
|
|
||||||
Bytes.set m len '\x80';
|
|
||||||
if Sys.word_size > 32 then (
|
|
||||||
Bytes.set m (mlen - 8) (Char.unsafe_chr ((blen lsr 56) land 0xFF));
|
|
||||||
Bytes.set m (mlen - 7) (Char.unsafe_chr ((blen lsr 48) land 0xFF));
|
|
||||||
Bytes.set m (mlen - 6) (Char.unsafe_chr ((blen lsr 40) land 0xFF));
|
|
||||||
Bytes.set m (mlen - 5) (Char.unsafe_chr ((blen lsr 32) land 0xFF))
|
|
||||||
);
|
|
||||||
Bytes.set m (mlen - 4) (Char.unsafe_chr ((blen lsr 24) land 0xFF));
|
|
||||||
Bytes.set m (mlen - 3) (Char.unsafe_chr ((blen lsr 16) land 0xFF));
|
|
||||||
Bytes.set m (mlen - 2) (Char.unsafe_chr ((blen lsr 8) land 0xFF));
|
|
||||||
Bytes.set m (mlen - 1) (Char.unsafe_chr (blen land 0xFF));
|
|
||||||
m
|
|
||||||
in
|
|
||||||
(* Operations on int32 *)
|
|
||||||
let ( &&& ) = ( land ) in
|
|
||||||
let ( lor ) = Int32.logor in
|
|
||||||
let ( lxor ) = Int32.logxor in
|
|
||||||
let ( land ) = Int32.logand in
|
|
||||||
let ( ++ ) = Int32.add in
|
|
||||||
let lnot = Int32.lognot in
|
|
||||||
let sr = Int32.shift_right in
|
|
||||||
let sl = Int32.shift_left in
|
|
||||||
let cls n x = sl x n lor Int32.shift_right_logical x (32 - n) in
|
|
||||||
(* Start *)
|
|
||||||
let m = sha_1_pad s in
|
|
||||||
let w = Array.make 16 0l in
|
|
||||||
let h0 = ref 0x67452301l in
|
|
||||||
let h1 = ref 0xEFCDAB89l in
|
|
||||||
let h2 = ref 0x98BADCFEl in
|
|
||||||
let h3 = ref 0x10325476l in
|
|
||||||
let h4 = ref 0xC3D2E1F0l in
|
|
||||||
let a = ref 0l in
|
|
||||||
let b = ref 0l in
|
|
||||||
let c = ref 0l in
|
|
||||||
let d = ref 0l in
|
|
||||||
let e = ref 0l in
|
|
||||||
for i = 0 to (Bytes.length m / 64) - 1 do
|
|
||||||
(* For each block *)
|
|
||||||
(* Fill w *)
|
|
||||||
let base = i * 64 in
|
|
||||||
for j = 0 to 15 do
|
|
||||||
let k = base + (j * 4) in
|
|
||||||
w.(j) <-
|
|
||||||
sl (Int32.of_int (Char.code @@ Bytes.get m k)) 24
|
|
||||||
lor sl (Int32.of_int (Char.code @@ Bytes.get m (k + 1))) 16
|
|
||||||
lor sl (Int32.of_int (Char.code @@ Bytes.get m (k + 2))) 8
|
|
||||||
lor Int32.of_int (Char.code @@ Bytes.get m (k + 3))
|
|
||||||
done;
|
|
||||||
(* Loop *)
|
|
||||||
a := !h0;
|
|
||||||
b := !h1;
|
|
||||||
c := !h2;
|
|
||||||
d := !h3;
|
|
||||||
e := !h4;
|
|
||||||
for t = 0 to 79 do
|
|
||||||
let f, k =
|
|
||||||
if t <= 19 then
|
|
||||||
!b land !c lor (lnot !b land !d), 0x5A827999l
|
|
||||||
else if t <= 39 then
|
|
||||||
!b lxor !c lxor !d, 0x6ED9EBA1l
|
|
||||||
else if t <= 59 then
|
|
||||||
!b land !c lor (!b land !d) lor (!c land !d), 0x8F1BBCDCl
|
|
||||||
else
|
|
||||||
!b lxor !c lxor !d, 0xCA62C1D6l
|
|
||||||
in
|
|
||||||
let s = t &&& 0xF in
|
|
||||||
if t >= 16 then
|
|
||||||
w.(s) <-
|
|
||||||
cls 1
|
|
||||||
(w.(s + 13 &&& 0xF)
|
|
||||||
lxor w.(s + 8 &&& 0xF)
|
|
||||||
lxor w.(s + 2 &&& 0xF)
|
|
||||||
lxor w.(s));
|
|
||||||
let temp = cls 5 !a ++ f ++ !e ++ w.(s) ++ k in
|
|
||||||
e := !d;
|
|
||||||
d := !c;
|
|
||||||
c := cls 30 !b;
|
|
||||||
b := !a;
|
|
||||||
a := temp
|
|
||||||
done;
|
|
||||||
(* Update *)
|
|
||||||
h0 := !h0 ++ !a;
|
|
||||||
h1 := !h1 ++ !b;
|
|
||||||
h2 := !h2 ++ !c;
|
|
||||||
h3 := !h3 ++ !d;
|
|
||||||
h4 := !h4 ++ !e
|
|
||||||
done;
|
|
||||||
let h = Bytes.create 20 in
|
|
||||||
let i2s h k i =
|
|
||||||
Bytes.set h k (Char.unsafe_chr (Int32.to_int (sr i 24) &&& 0xFF));
|
|
||||||
Bytes.set h (k + 1) (Char.unsafe_chr (Int32.to_int (sr i 16) &&& 0xFF));
|
|
||||||
Bytes.set h (k + 2) (Char.unsafe_chr (Int32.to_int (sr i 8) &&& 0xFF));
|
|
||||||
Bytes.set h (k + 3) (Char.unsafe_chr (Int32.to_int i &&& 0xFF))
|
|
||||||
in
|
|
||||||
i2s h 0 !h0;
|
|
||||||
i2s h 4 !h1;
|
|
||||||
i2s h 8 !h2;
|
|
||||||
i2s h 12 !h3;
|
|
||||||
i2s h 16 !h4;
|
|
||||||
Bytes.unsafe_to_string h
|
|
||||||
|
|
||||||
(*---------------------------------------------------------------------------
|
|
||||||
Copyright (c) 2008 The uuidm programmers
|
|
||||||
|
|
||||||
Permission to use, copy, modify, and/or distribute this software for any
|
|
||||||
purpose with or without fee is hereby granted, provided that the above
|
|
||||||
copyright notice and this permission notice appear in all copies.
|
|
||||||
|
|
||||||
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
|
|
||||||
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
|
|
||||||
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
|
|
||||||
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
|
|
||||||
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
|
|
||||||
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
|
|
||||||
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
|
||||||
---------------------------------------------------------------------------*)
|
|
||||||
|
|
||||||
module M = Moonpool
|
|
||||||
module MU = Moonpool_unix
|
|
||||||
|
|
||||||
type state = {
|
|
||||||
runner: M.Runner.t;
|
|
||||||
hashes: (string, string) Hashtbl.t M.Lock.t;
|
|
||||||
delay: float;
|
|
||||||
}
|
|
||||||
|
|
||||||
(*
|
|
||||||
let hash_dir ~runner (d:string) =
|
|
||||||
if not (Sys.exists d) then ""
|
|
||||||
else
|
|
||||||
if Sys.is_directory d then (
|
|
||||||
|
|
||||||
let children = List.map
|
|
||||||
|
|
||||||
)
|
|
||||||
|
|
||||||
*)
|
|
||||||
Loading…
Add table
Reference in a new issue