From d3188a95b9bf8077ce9a185d8f8fbb16cb71e572 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 25 Jun 2024 14:47:45 -0400 Subject: [PATCH] rename moonpool-unix to moonpool-io, will use `poll` --- dune-project | 3 +- moonpool-unix.opam => moonpool-io.opam | 1 + src/unix/dune | 7 +- src/unix/moonpool_unix.ml | 20 ---- test/unix/dune | 4 - test/unix/echo_server.ml | 62 ---------- test/unix/t_hash.ml | 154 ------------------------- 7 files changed, 7 insertions(+), 244 deletions(-) rename moonpool-unix.opam => moonpool-io.opam (96%) delete mode 100644 src/unix/moonpool_unix.ml delete mode 100644 test/unix/dune delete mode 100644 test/unix/echo_server.ml delete mode 100644 test/unix/t_hash.ml diff --git a/dune-project b/dune-project index 55756c97..95b0c471 100644 --- a/dune-project +++ b/dune-project @@ -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 diff --git a/moonpool-unix.opam b/moonpool-io.opam similarity index 96% rename from moonpool-unix.opam rename to moonpool-io.opam index 62cdaf7e..67b6a30e 100644 --- a/moonpool-unix.opam +++ b/moonpool-io.opam @@ -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} diff --git a/src/unix/dune b/src/unix/dune index eaf20b56..74e5950d 100644 --- a/src/unix/dune +++ b/src/unix/dune @@ -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) diff --git a/src/unix/moonpool_unix.ml b/src/unix/moonpool_unix.ml deleted file mode 100644 index cde342f2..00000000 --- a/src/unix/moonpool_unix.ml +++ /dev/null @@ -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 diff --git a/test/unix/dune b/test/unix/dune deleted file mode 100644 index 8098a9e9..00000000 --- a/test/unix/dune +++ /dev/null @@ -1,4 +0,0 @@ -(executables - (names t_hash echo_server) - ;(package moonpool-unix) - (libraries moonpool moonpool-unix trace.core trace-tef)) diff --git a/test/unix/echo_server.ml b/test/unix/echo_server.ml deleted file mode 100644 index d3b56450..00000000 --- a/test/unix/echo_server.ml +++ /dev/null @@ -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 () diff --git a/test/unix/t_hash.ml b/test/unix/t_hash.ml deleted file mode 100644 index 4adbbbe5..00000000 --- a/test/unix/t_hash.ml +++ /dev/null @@ -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 - - ) - - *)