diff --git a/src/unix/async_io.ml b/src/io/async_io.ml similarity index 100% rename from src/unix/async_io.ml rename to src/io/async_io.ml diff --git a/src/unix/async_io.mli b/src/io/async_io.mli similarity index 100% rename from src/unix/async_io.mli rename to src/io/async_io.mli diff --git a/src/unix/cancel_handle.ml b/src/io/cancel_handle.ml similarity index 100% rename from src/unix/cancel_handle.ml rename to src/io/cancel_handle.ml diff --git a/src/unix/cancel_handle.mli b/src/io/cancel_handle.mli similarity index 100% rename from src/unix/cancel_handle.mli rename to src/io/cancel_handle.mli diff --git a/src/unix/common_.ml b/src/io/common_.ml similarity index 100% rename from src/unix/common_.ml rename to src/io/common_.ml diff --git a/src/unix/dune b/src/io/dune similarity index 100% rename from src/unix/dune rename to src/io/dune diff --git a/src/unix/ev_loop.ml b/src/io/ev_loop.ml similarity index 100% rename from src/unix/ev_loop.ml rename to src/io/ev_loop.ml diff --git a/src/unix/ev_loop.mli b/src/io/ev_loop.mli similarity index 100% rename from src/unix/ev_loop.mli rename to src/io/ev_loop.mli diff --git a/src/unix/fd.ml b/src/io/fd.ml similarity index 100% rename from src/unix/fd.ml rename to src/io/fd.ml diff --git a/src/unix/heap_.ml b/src/io/heap_.ml similarity index 100% rename from src/unix/heap_.ml rename to src/io/heap_.ml diff --git a/src/unix/heap_.mli b/src/io/heap_.mli similarity index 100% rename from src/unix/heap_.mli rename to src/io/heap_.mli diff --git a/src/io/moonpool_io.ml b/src/io/moonpool_io.ml new file mode 100644 index 00000000..cde342f2 --- /dev/null +++ b/src/io/moonpool_io.ml @@ -0,0 +1,20 @@ +(** {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/src/unix/sockaddr.ml b/src/io/sockaddr.ml similarity index 100% rename from src/unix/sockaddr.ml rename to src/io/sockaddr.ml diff --git a/src/unix/time.mli b/src/io/time.mli similarity index 100% rename from src/unix/time.mli rename to src/io/time.mli diff --git a/src/unix/time.mtime.ml b/src/io/time.mtime.ml similarity index 100% rename from src/unix/time.mtime.ml rename to src/io/time.mtime.ml diff --git a/src/unix/time.unix.ml b/src/io/time.unix.ml similarity index 100% rename from src/unix/time.unix.ml rename to src/io/time.unix.ml diff --git a/src/unix/timer.ml b/src/io/timer.ml similarity index 100% rename from src/unix/timer.ml rename to src/io/timer.ml diff --git a/src/unix/timer.mli b/src/io/timer.mli similarity index 100% rename from src/unix/timer.mli rename to src/io/timer.mli diff --git a/test/io/dune b/test/io/dune new file mode 100644 index 00000000..77e9b19c --- /dev/null +++ b/test/io/dune @@ -0,0 +1,4 @@ +(executables + (names t_hash echo_server) + ;(package moonpool-unix) + (libraries moonpool moonpool-io trace.core trace-tef)) diff --git a/test/io/echo_server.ml b/test/io/echo_server.ml new file mode 100644 index 00000000..da2c30c2 --- /dev/null +++ b/test/io/echo_server.ml @@ -0,0 +1,62 @@ +module M = Moonpool +module MU = Moonpool_io +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/io/t_hash.ml b/test/io/t_hash.ml new file mode 100644 index 00000000..4adbbbe5 --- /dev/null +++ b/test/io/t_hash.ml @@ -0,0 +1,154 @@ +(* 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 + + ) + + *)