From 911f34f132f7bc5ea14e9d5c32841a508f6dd828 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 8 Feb 2024 20:40:41 -0500 Subject: [PATCH] wip: tests for moonpool.unix --- test/unix/dune | 4 + test/unix/echo_server.ml | 57 +++++++++++++++ test/unix/t_hash.ml | 154 +++++++++++++++++++++++++++++++++++++++ 3 files changed, 215 insertions(+) create mode 100644 test/unix/dune create mode 100644 test/unix/echo_server.ml create mode 100644 test/unix/t_hash.ml diff --git a/test/unix/dune b/test/unix/dune new file mode 100644 index 00000000..18c39455 --- /dev/null +++ b/test/unix/dune @@ -0,0 +1,4 @@ + +(executables + (names t_hash echo_server) + (libraries moonpool moonpool.unix trace.core trace-tef)) diff --git a/test/unix/echo_server.ml b/test/unix/echo_server.ml new file mode 100644 index 00000000..e9e0426e --- /dev/null +++ b/test/unix/echo_server.ml @@ -0,0 +1,57 @@ +module M = Moonpool +module MU = Moonpool_unix +module Trace = Trace_core + +let ( let@ ) = ( @@ ) +let spf = Printf.sprintf + +let str_of_sockaddr = function + | Unix.ADDR_UNIX s -> s + | Unix.ADDR_INET (addr, port) -> + spf "%s:%d" (Unix.string_of_inet_addr addr) port + +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@ () = MU.main ~runner in + Trace.set_thread_name "main"; + Printf.printf "IN MAIN\n%!"; + + MU.TCP_server.with_server ~port ~runner () + ~after_init:(fun self -> + Printf.printf "listening on port %d\n%!" (MU.TCP_server.port self)) + ~handle_client:(fun _server addr ic oc -> + let@ _sp = + Trace.with_span ~__FILE__ ~__LINE__ "handle.client" ~data:(fun () -> + [ "addr", `String (str_of_sockaddr addr) ]) + in + + let buf = Bytes.create 32 in + let continue = ref true in + while !continue do + Trace.message "read"; + let n = MU.IO_in.input ic buf 0 (Bytes.length buf) in + if n = 0 then continue := false; + Trace.messagef (fun k -> k "got %dB" n); + MU.IO_out.output oc buf 0 n; + MU.IO_out.flush oc; + Trace.message "write" + (* MU.sleep_s 0.02 *) + done) + +let () = + 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 new file mode 100644 index 00000000..4adbbbe5 --- /dev/null +++ b/test/unix/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 + + ) + + *)