simon/moonpool
1
0
Fork 0
mirror of https://github.com/c-cube/moonpool.git synced 2025-12-06 03:05:30 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

rename moonpool-unix to moonpool-io, will use poll

Browse source
This commit is contained in:
Simon Cruanes 2024-06-25 14:47:45 -04:00
parent 879d380faf
commit d3188a95b9
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
7 changed files with 7 additions and 244 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
dune-project
View file

@ -34,11 +34,12 @@
(thread pool domain futures fork-join)))
(package
(name moonpool-unix)
(name moonpool-io)
(synopsis "Non blocking IO for Moonpool based on Unix")
(depends
(ocaml (>= 5.0))
dune
(poll (and (>= 3.0) (< 4.0)))
(iostream (>= 0.2.2))
(trace :with-test))
(depopts

1
moonpool-unix.opam → moonpool-io.opam
View file

@ -11,6 +11,7 @@ bug-reports: "https://github.com/c-cube/moonpool/issues"
depends: [
"ocaml" {>= "5.0"}
"dune" {>= "3.0"}
"poll" {>= "3.0" & < "4.0"}
"iostream" {>= "0.2.2"}
"trace" {with-test}
"odoc" {with-doc}

7
src/unix/dune
View file

@ -1,11 +1,12 @@
(library
(name moonpool_unix)
(public_name moonpool-unix)
(synopsis "Simple Unix-based event loop for moonpool")
(name moonpool_io)
(public_name moonpool-io)
(synopsis "Async IOs for moonpool")
(private_modules common_ heap_)
(libraries
moonpool
moonpool.fib
(re_export poll)
unix
iostream
(re_export iostream.types)

20
src/unix/moonpool_unix.ml
View file

@ -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

4
test/unix/dune
View file

@ -1,4 +0,0 @@
(executables
(names t_hash echo_server)
;(package moonpool-unix)
(libraries moonpool moonpool-unix trace.core trace-tef))

62
test/unix/echo_server.ml
View file

@ -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 ()

154
test/unix/t_hash.ml
View file

@ -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
)
*)