├── fuzz ├── fuzz_buf_read.mli ├── fuzz_buf_write.mli ├── dune ├── fuzz_buf_write.ml └── fuzz_buf_read.ml ├── .gitignore ├── .dockerignore ├── tests ├── dune ├── network.md ├── nounix │ ├── dune │ └── nounix.ml ├── trace.md ├── random.md ├── debug.md ├── lf_queue.md ├── flow.md ├── time.md ├── mocks.md ├── condition.md ├── sync.md ├── domains.md └── mutex.md ├── lib_eio_luv ├── tests │ ├── dune │ ├── files.md │ └── poll.md ├── dune └── eio_luv.mli ├── stress ├── dune └── stress_semaphore.ml ├── doc ├── dune └── prelude.ml ├── lib_main ├── eio_main.default.ml ├── dune ├── eio_main.mli └── eio_main.linux.ml ├── lib_eio ├── mock │ ├── dune │ ├── eio_mock.ml │ ├── backend.mli │ ├── action.ml │ ├── handler.ml │ ├── backend.ml │ ├── flow.ml │ ├── net.ml │ └── eio_mock.mli ├── utils │ ├── dune │ ├── eio_utils.ml │ ├── suspended.ml │ ├── zzz.mli │ ├── zzz.ml │ ├── lf_queue.mli │ └── lf_queue.ml ├── core │ ├── dune │ ├── hook.ml │ ├── suspend.ml │ ├── waiters.mli │ ├── eio__core.ml │ ├── single_waiter.ml │ ├── exn.ml │ ├── debug.ml │ ├── waiters.ml │ ├── ctf.mli │ ├── switch.ml │ └── promise.ml ├── unix │ ├── dune │ ├── ctf_unix.mli │ ├── ctf_unix.ml │ ├── eio_unix.ml │ └── eio_unix.mli ├── generic.ml ├── dune ├── generic.mli ├── time.ml ├── condition.ml ├── semaphore.mli ├── domain_manager.ml ├── semaphore.ml ├── eio.ml ├── path.ml ├── stream.mli ├── fs.ml ├── condition.mli ├── flow.ml ├── eio_mutex.mli ├── eio_mutex.ml ├── flow.mli ├── path.mli ├── stream.ml └── net.ml ├── dune ├── bench ├── dune ├── bench_buf_read.ml ├── bench_yield.ml ├── bench_stream.ml ├── bench_semaphore.ml ├── bench_cancel.ml ├── bench_mutex.ml └── bench_promise.ml ├── lib_eio_linux ├── dune ├── tests │ ├── dune │ ├── bench_noop.ml │ ├── basic_eio_linux.ml │ ├── fd_passing.md │ ├── eurcp.ml │ ├── eurcp_lib.ml │ └── test.ml └── eio_stubs.c ├── Makefile ├── Dockerfile ├── eio_main.opam ├── eio_luv.opam ├── eio_linux.opam ├── eio.opam ├── dune-project ├── LICENSE.md └── CHANGES.md /fuzz/fuzz_buf_read.mli: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /fuzz/fuzz_buf_write.mli: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | .*.swp 3 | *.install 4 | -------------------------------------------------------------------------------- /.dockerignore: -------------------------------------------------------------------------------- 1 | Dockerfile 2 | _build 3 | .git 4 | **/*.swp 5 | -------------------------------------------------------------------------------- /tests/dune: -------------------------------------------------------------------------------- 1 | (mdx 2 | (package eio_main) 3 | (packages eio_main)) 4 | -------------------------------------------------------------------------------- /lib_eio_luv/tests/dune: -------------------------------------------------------------------------------- 1 | (mdx 2 | (package eio_luv) 3 | (packages eio_luv)) 4 | -------------------------------------------------------------------------------- /stress/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (names stress_semaphore) 3 | (libraries eio_main)) 4 | -------------------------------------------------------------------------------- /tests/network.md: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Leonidas-from-XIV/eio/main/tests/network.md -------------------------------------------------------------------------------- /doc/dune: -------------------------------------------------------------------------------- 1 | (mdx 2 | (package eio_main) 3 | (packages eio_main) 4 | (files multicore.md)) 5 | -------------------------------------------------------------------------------- /lib_main/eio_main.default.ml: -------------------------------------------------------------------------------- 1 | let run fn = Eio_luv.run (fun env -> fn (env :> Eio.Stdenv.t)) 2 | -------------------------------------------------------------------------------- /lib_eio/mock/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name eio_mock) 3 | (public_name eio.mock) 4 | (libraries eio eio.utils)) 5 | -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | (mdx 2 | (package eio_main) 3 | (packages eio_main) 4 | (preludes doc/prelude.ml) 5 | (files README.md)) 6 | -------------------------------------------------------------------------------- /lib_eio/utils/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name eio_utils) 3 | (public_name eio.utils) 4 | (libraries eio psq fmt optint)) 5 | -------------------------------------------------------------------------------- /tests/nounix/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name nounix) 3 | (package eio) 4 | (forbidden_libraries unix) 5 | (libraries eio)) 6 | -------------------------------------------------------------------------------- /lib_eio/core/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name eio__core) 3 | (public_name eio.core) 4 | (libraries cstruct hmap lwt-dllist fmt)) 5 | -------------------------------------------------------------------------------- /lib_eio/unix/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name eio_unix) 3 | (public_name eio.unix) 4 | (libraries eio unix threads mtime.clock.os)) 5 | -------------------------------------------------------------------------------- /fuzz/dune: -------------------------------------------------------------------------------- 1 | (tests 2 | (package eio) 3 | (libraries cstruct crowbar fmt astring eio eio.mock) 4 | (names fuzz_buf_read fuzz_buf_write)) 5 | -------------------------------------------------------------------------------- /lib_eio_luv/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name eio_luv) 3 | (public_name eio_luv) 4 | (libraries eio eio.unix luv luv_unix eio.utils logs fmt)) 5 | -------------------------------------------------------------------------------- /lib_eio/mock/eio_mock.ml: -------------------------------------------------------------------------------- 1 | module Action = Action 2 | module Handler = Handler 3 | module Flow = Flow 4 | module Net = Net 5 | module Backend = Backend 6 | -------------------------------------------------------------------------------- /lib_eio/generic.ml: -------------------------------------------------------------------------------- 1 | type 'a ty = .. 2 | 3 | class type t = object 4 | method probe : 'a. 'a ty -> 'a option 5 | end 6 | 7 | let probe (t : #t) ty = t#probe ty 8 | -------------------------------------------------------------------------------- /bench/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (names bench_stream bench_promise bench_semaphore bench_yield bench_cancel bench_mutex 3 | bench_buf_read) 4 | (libraries eio_main)) 5 | -------------------------------------------------------------------------------- /lib_eio/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name eio) 3 | (public_name eio) 4 | (flags (:standard -open Eio__core -open Eio__core.Private)) 5 | (libraries eio__core cstruct lwt-dllist fmt bigstringaf)) 6 | -------------------------------------------------------------------------------- /lib_eio/utils/eio_utils.ml: -------------------------------------------------------------------------------- 1 | (** Utilities for implementing Eio event loops. 2 | 3 | These aren't intended for users of Eio. *) 4 | 5 | module Lf_queue = Lf_queue 6 | module Suspended = Suspended 7 | module Zzz = Zzz 8 | -------------------------------------------------------------------------------- /lib_main/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name eio_main) 3 | (public_name eio_main) 4 | (libraries eio_luv 5 | (select eio_main.ml from 6 | (eio_linux -> eio_main.linux.ml) 7 | ( -> eio_main.default.ml)))) 8 | -------------------------------------------------------------------------------- /lib_eio_linux/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name eio_linux) 3 | (public_name eio_linux) 4 | (enabled_if (= %{system} "linux")) 5 | (foreign_stubs 6 | (language c) 7 | (flags :standard -D_LARGEFILE64_SOURCE) 8 | (names eio_stubs)) 9 | (libraries eio eio.utils eio.unix uring logs fmt)) 10 | -------------------------------------------------------------------------------- /tests/nounix/nounix.ml: -------------------------------------------------------------------------------- 1 | (* This module also checks that Eio doesn't pull in a dependency on Unix. 2 | See the [dune] file. *) 3 | 4 | module Ctf = Eio.Private.Ctf 5 | 6 | let () = 7 | let bs = Cstruct.create 8 in 8 | Ctf.BS.set_int64_le bs.buffer 0 1234L; 9 | assert (Cstruct.LE.get_uint64 bs 0 = 1234L) 10 | -------------------------------------------------------------------------------- /tests/trace.md: -------------------------------------------------------------------------------- 1 | ```ocaml 2 | # #require "eio_main";; 3 | # open Eio.Std;; 4 | # Eio_main.run @@ fun _env -> 5 | traceln "One-line trace"; 6 | traceln "@[A nested list@,Foo@,Bar@]"; 7 | traceln "Trace with position" ~__POS__:("trace.md", 5, 1, 10);; 8 | +One-line trace 9 | +A nested list 10 | + Foo 11 | + Bar 12 | +Trace with position [trace.md:5] 13 | - : unit = () 14 | ``` 15 | -------------------------------------------------------------------------------- /lib_eio/core/hook.ml: -------------------------------------------------------------------------------- 1 | type t = 2 | | Null 3 | | Node : 'a Lwt_dllist.node -> t 4 | | Node_with_mutex : 'a Lwt_dllist.node * Mutex.t -> t 5 | 6 | let null = Null 7 | 8 | let remove = function 9 | | Null -> () 10 | | Node n -> Lwt_dllist.remove n 11 | | Node_with_mutex (n, m) -> 12 | Mutex.lock m; 13 | Fun.protect ~finally:(fun () -> Mutex.unlock m) 14 | (fun () -> Lwt_dllist.remove n) 15 | -------------------------------------------------------------------------------- /lib_eio/core/suspend.ml: -------------------------------------------------------------------------------- 1 | type 'a enqueue = ('a, exn) result -> unit 2 | type _ Effect.t += Suspend : (Cancel.fiber_context -> 'a enqueue -> unit) -> 'a Effect.t 3 | 4 | let enter_unchecked fn = Effect.perform (Suspend fn) 5 | 6 | let enter fn = 7 | enter_unchecked @@ fun fiber enqueue -> 8 | match Cancel.Fiber_context.get_error fiber with 9 | | None -> fn fiber enqueue 10 | | Some ex -> enqueue (Error ex) 11 | -------------------------------------------------------------------------------- /lib_eio/generic.mli: -------------------------------------------------------------------------------- 1 | type 'a ty = .. 2 | (** An ['a ty] is a query for a feature of type ['a]. *) 3 | 4 | class type t = object 5 | method probe : 'a. 'a ty -> 'a option 6 | end 7 | 8 | val probe : #t -> 'a ty -> 'a option 9 | (** [probe t feature] checks whether [t] supports [feature]. 10 | This is mostly for internal use. 11 | For example, {!Eio_unix.FD.peek_opt} uses this to get the underlying Unix file descriptor from a flow. *) 12 | -------------------------------------------------------------------------------- /bench/bench_buf_read.ml: -------------------------------------------------------------------------------- 1 | module R = Eio.Buf_read 2 | 3 | let test_data = String.init 100_000_000 (fun _ -> 'x') 4 | 5 | let () = 6 | let r = R.of_string test_data in 7 | let t0 = Unix.gettimeofday () in 8 | let i = ref 0 in 9 | try 10 | while true do 11 | assert (R.any_char r = 'x'); 12 | incr i 13 | done 14 | with End_of_file -> 15 | let t1 = Unix.gettimeofday () in 16 | Eio.traceln "Read %d bytes in %.3fs" !i (t1 -. t0) 17 | -------------------------------------------------------------------------------- /lib_eio/time.ml: -------------------------------------------------------------------------------- 1 | exception Timeout 2 | 3 | class virtual clock = object 4 | method virtual now : float 5 | method virtual sleep_until : float -> unit 6 | end 7 | 8 | let now (t : #clock) = t#now 9 | 10 | let sleep_until (t : #clock) time = t#sleep_until time 11 | 12 | let sleep t d = sleep_until t (now t +. d) 13 | 14 | let with_timeout t d = Fiber.first (fun () -> sleep t d; Error `Timeout) 15 | let with_timeout_exn t d = Fiber.first (fun () -> sleep t d; raise Timeout) 16 | -------------------------------------------------------------------------------- /lib_eio/utils/suspended.ml: -------------------------------------------------------------------------------- 1 | (** A suspended fiber with its context. *) 2 | 3 | open Effect.Deep 4 | module Ctf = Eio.Private.Ctf 5 | 6 | type 'a t = { 7 | fiber : Eio.Private.Fiber_context.t; 8 | k : ('a, [`Exit_scheduler]) continuation; 9 | } 10 | 11 | let tid t = Eio.Private.Fiber_context.tid t.fiber 12 | 13 | let continue t v = 14 | Ctf.note_switch (tid t); 15 | continue t.k v 16 | 17 | let discontinue t ex = 18 | Ctf.note_switch (tid t); 19 | discontinue t.k ex 20 | -------------------------------------------------------------------------------- /lib_eio/core/waiters.mli: -------------------------------------------------------------------------------- 1 | (* See [eio__core.mli] for details. *) 2 | 3 | type 'a t 4 | 5 | val create : unit -> 'a t 6 | 7 | val wake_all : 'a t -> 'a -> unit 8 | 9 | val wake_one : 'a t -> 'a -> [`Ok | `Queue_empty] 10 | 11 | val is_empty : 'a t -> bool 12 | 13 | val await : 14 | mutex:Mutex.t option -> 15 | 'a t -> Ctf.id -> 'a 16 | 17 | val await_internal : 18 | mutex:Mutex.t option -> 19 | 'a t -> Ctf.id -> Cancel.fiber_context -> 20 | (('a, exn) result -> unit) -> unit 21 | -------------------------------------------------------------------------------- /tests/random.md: -------------------------------------------------------------------------------- 1 | # Setting up the environment 2 | 3 | ```ocaml 4 | # #require "eio_main";; 5 | ``` 6 | 7 | ```ocaml 8 | open Eio.Std 9 | ``` 10 | 11 | # Basic check for randomness 12 | 13 | ```ocaml 14 | # Eio_main.run @@ fun env -> 15 | let src = Eio.Stdenv.secure_random env in 16 | let b1 = Cstruct.create 8 in 17 | let b2 = Cstruct.create 8 in 18 | Eio.Flow.read_exact src b1; 19 | Eio.Flow.read_exact src b2; 20 | assert (not (Cstruct.equal b1 b2));; 21 | - : unit = () 22 | ``` 23 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: all bench 2 | 3 | all: 4 | dune build @runtest @all 5 | 6 | bench: 7 | dune exec -- ./bench/bench_buf_read.exe 8 | dune exec -- ./bench/bench_mutex.exe 9 | dune exec -- ./bench/bench_yield.exe 10 | dune exec -- ./bench/bench_promise.exe 11 | dune exec -- ./bench/bench_stream.exe 12 | dune exec -- ./bench/bench_semaphore.exe 13 | dune exec -- ./bench/bench_cancel.exe 14 | dune exec -- ./lib_eio_linux/tests/bench_noop.exe 15 | 16 | test_luv: 17 | rm -rf _build 18 | EIO_BACKEND=luv dune runtest 19 | 20 | docker: 21 | docker build -t eio . 22 | -------------------------------------------------------------------------------- /lib_eio/unix/ctf_unix.mli: -------------------------------------------------------------------------------- 1 | val timestamper : Eio.Private.Ctf.log_buffer -> int -> unit 2 | (** Uses [Mtime_clock] to write timestamps. *) 3 | 4 | val mmap_buffer : size:int -> string -> Eio.Private.Ctf.log_buffer 5 | (** [mmap_buffer ~size path] initialises file [path] as an empty buffer for tracing. *) 6 | 7 | val with_tracing : ?size:int -> string -> (unit -> 'a) -> 'a 8 | (** [with_tracing path fn] is a convenience function that uses {!mmap_buffer} to create a log buffer, 9 | calls {!Ctf.Control.start} to start recording, runs [fn], and then stops recording. *) 10 | -------------------------------------------------------------------------------- /lib_eio/mock/backend.mli: -------------------------------------------------------------------------------- 1 | (** A dummy Eio backend with no actual IO. 2 | 3 | This backend does not support the use of multiple domains or systhreads, 4 | but the tradeoff is that it can reliably detect deadlock, because if the 5 | run queue is empty then it knows that no wake up event can be coming from 6 | elsewhere. *) 7 | 8 | exception Deadlock_detected 9 | 10 | val run : (unit -> 'a) -> 'a 11 | (** [run fn] runs an event loop and then calls [fn env] within it. 12 | @raise Deadlock_detected if the run queue becomes empty but [fn] hasn't returned. *) 13 | -------------------------------------------------------------------------------- /lib_eio/core/eio__core.ml: -------------------------------------------------------------------------------- 1 | module Promise = Promise 2 | module Fiber = Fiber 3 | module Switch = Switch 4 | module Cancel = Cancel 5 | module Exn = Exn 6 | module Private = struct 7 | module Suspend = Suspend 8 | module Waiters = Waiters 9 | module Ctf = Ctf 10 | module Fiber_context = Cancel.Fiber_context 11 | module Debug = Debug 12 | 13 | module Effects = struct 14 | type 'a enqueue = 'a Suspend.enqueue 15 | type _ Effect.t += 16 | | Suspend = Suspend.Suspend 17 | | Fork = Fiber.Fork 18 | | Get_context = Cancel.Get_context 19 | end 20 | end 21 | -------------------------------------------------------------------------------- /lib_eio/mock/action.ml: -------------------------------------------------------------------------------- 1 | open Eio.Std 2 | 3 | type 'a t = [ 4 | | `Return of 'a 5 | | `Raise of exn 6 | | `Await of 'a Eio.Promise.or_exn 7 | | `Yield_then of 'a t 8 | | `Run of unit -> 'a 9 | ] 10 | 11 | let rec run = function 12 | | `Return x -> x 13 | | `Raise ex -> raise ex 14 | | `Await p -> Promise.await_exn p 15 | | `Yield_then t -> Fiber.yield (); run t 16 | | `Run fn -> fn () 17 | 18 | let rec map f = function 19 | | `Return x -> `Return (f x) 20 | | `Raise ex -> `Raise ex 21 | | `Await p -> `Run (fun () -> f (Promise.await_exn p)) 22 | | `Yield_then t -> `Yield_then (map f t) 23 | | `Run fn -> `Run (fun () -> f (fn ())) 24 | -------------------------------------------------------------------------------- /lib_eio/condition.ml: -------------------------------------------------------------------------------- 1 | type t = { 2 | waiters: unit Waiters.t; 3 | mutex: Mutex.t; 4 | id: Ctf.id 5 | } 6 | 7 | let create () = { 8 | waiters = Waiters.create (); 9 | id = Ctf.mint_id (); 10 | mutex = Mutex.create (); 11 | } 12 | 13 | let await t mutex = 14 | Mutex.lock t.mutex; 15 | Eio_mutex.unlock mutex; 16 | match Waiters.await ~mutex:(Some t.mutex) t.waiters t.id with 17 | | () -> Eio_mutex.lock mutex 18 | | exception ex -> Eio_mutex.lock mutex; raise ex 19 | 20 | let await_no_mutex t = 21 | Mutex.lock t.mutex; 22 | Waiters.await ~mutex:(Some t.mutex) t.waiters t.id 23 | 24 | let broadcast t = 25 | Waiters.wake_all t.waiters () 26 | -------------------------------------------------------------------------------- /tests/debug.md: -------------------------------------------------------------------------------- 1 | # Setting up the environment 2 | 3 | ```ocaml 4 | # #require "eio_main";; 5 | # open Eio.Std;; 6 | ``` 7 | 8 | ## Overriding tracing 9 | 10 | ```ocaml 11 | # Eio_main.run @@ fun env -> 12 | let debug = Eio.Stdenv.debug env in 13 | let my_traceln = { 14 | Eio.Debug.traceln = fun ?__POS__:_ fmt -> Fmt.epr ("++" ^^ fmt ^^ "@.") 15 | } in 16 | Fiber.both 17 | (fun () -> 18 | Fiber.with_binding debug#traceln my_traceln @@ fun () -> 19 | Fiber.both 20 | (fun () -> traceln "a") 21 | (fun () -> Fiber.yield (); traceln "b") 22 | ) 23 | (fun () -> traceln "c");; 24 | ++a 25 | +c 26 | ++b 27 | - : unit = () 28 | ``` 29 | -------------------------------------------------------------------------------- /lib_eio/mock/handler.ml: -------------------------------------------------------------------------------- 1 | type 'a actions = 'a Action.t list 2 | 3 | type 'a t = { 4 | default_action : 'a Action.t; 5 | mutable handler : (unit -> 'a); 6 | } 7 | 8 | let run t = t.handler () 9 | 10 | let set_handler t f = t.handler <- f 11 | 12 | let seq t actions = 13 | let actions = ref actions in 14 | let next () = 15 | match !actions with 16 | | [] -> Action.run t.default_action 17 | | x :: xs -> 18 | actions := xs; 19 | Action.run x 20 | in 21 | set_handler t next 22 | 23 | let run_default_action t = 24 | Action.run t.default_action 25 | 26 | let make default_action = 27 | { default_action; handler = (fun () -> Action.run default_action) } 28 | -------------------------------------------------------------------------------- /Dockerfile: -------------------------------------------------------------------------------- 1 | FROM ocaml/opam:debian-11-ocaml-5.0 2 | # Make sure we're using opam-2.1: 3 | RUN sudo ln -sf /usr/bin/opam-2.1 /usr/bin/opam 4 | # Add the alpha repository with some required preview versions of dependencies: 5 | RUN opam remote add alpha git+https://github.com/kit-ty-kate/opam-alpha-repository.git 6 | # Ensure opam-repository is up-to-date: 7 | RUN cd opam-repository && git pull origin 42a177d7ac37cd347aab366a90d20469203fc926 && opam update 8 | # Install utop for interactive use: 9 | RUN opam install utop fmt 10 | # Install Eio's dependencies (adding just the opam files first to help with caching): 11 | RUN mkdir eio 12 | WORKDIR eio 13 | COPY *.opam ./ 14 | RUN opam install --deps-only . 15 | # Build Eio: 16 | COPY . ./ 17 | RUN opam install . 18 | -------------------------------------------------------------------------------- /lib_eio/unix/ctf_unix.ml: -------------------------------------------------------------------------------- 1 | open Bigarray 2 | 3 | module Ctf = Eio.Private.Ctf 4 | 5 | let timestamper log_buffer ofs = 6 | let ns = Mtime.to_uint64_ns @@ Mtime_clock.now () in 7 | Ctf.BS.set_int64_le log_buffer ofs ns 8 | 9 | let mmap_buffer ~size path = 10 | let fd = Unix.(openfile path [O_RDWR; O_CREAT; O_TRUNC] 0o644) in 11 | Unix.set_close_on_exec fd; 12 | Unix.ftruncate fd size; 13 | let ba = array1_of_genarray (Unix.map_file fd char c_layout true [| size |]) in 14 | Unix.close fd; 15 | ba 16 | 17 | let with_tracing ?(size=0x100000) path fn = 18 | let buffer = mmap_buffer ~size path in 19 | let trace_config = Ctf.Control.make ~timestamper buffer in 20 | Ctf.Control.start trace_config; 21 | Fun.protect fn ~finally:(fun () -> Ctf.Control.stop trace_config) 22 | -------------------------------------------------------------------------------- /lib_eio_linux/tests/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name eurcp_lib) 3 | (enabled_if (= %{system} "linux")) 4 | (modules eurcp_lib) 5 | (libraries eio_linux)) 6 | 7 | (executable 8 | (name eurcp) 9 | (enabled_if (= %{system} "linux")) 10 | (modules eurcp) 11 | (libraries cmdliner logs.cli logs.fmt fmt.tty fmt.cli eurcp_lib)) 12 | 13 | (executable 14 | (name basic_eio_linux) 15 | (enabled_if (= %{system} "linux")) 16 | (modules basic_eio_linux) 17 | (libraries logs.fmt fmt.tty eurcp_lib)) 18 | 19 | (executables 20 | (names bench_noop) 21 | (enabled_if (= %{system} "linux")) 22 | (modules bench_noop) 23 | (libraries eio_linux)) 24 | 25 | (test 26 | (name test) 27 | (package eio_linux) 28 | (enabled_if (= %{system} "linux")) 29 | (modules test) 30 | (libraries alcotest eio_linux)) 31 | 32 | (mdx 33 | (package eio_linux) 34 | (enabled_if (= %{system} "linux")) 35 | (packages eio_linux)) 36 | -------------------------------------------------------------------------------- /lib_eio/core/single_waiter.ml: -------------------------------------------------------------------------------- 1 | (* A simplified version of [Waiters] that can only handle one waiter and is not thread-safe. *) 2 | 3 | type 'a t = { 4 | mutable wake : ('a, exn) result -> unit; 5 | } 6 | 7 | let create () = { wake = ignore } 8 | 9 | let wake t v = t.wake v 10 | 11 | let await t id = 12 | Suspend.enter @@ fun ctx enqueue -> 13 | Cancel.Fiber_context.set_cancel_fn ctx (fun ex -> 14 | t.wake <- ignore; 15 | enqueue (Error ex) 16 | ); 17 | t.wake <- (fun x -> 18 | let cleared = Cancel.Fiber_context.clear_cancel_fn ctx in 19 | (* We're not attempting to be thread-safe, so the cancel function can 20 | only be cleared from the same domain. In that case, [wake] will have 21 | been reset before switching to another fiber. *) 22 | assert cleared; 23 | t.wake <- ignore; 24 | Ctf.note_read ~reader:id ctx.tid; 25 | enqueue x 26 | ) 27 | -------------------------------------------------------------------------------- /lib_main/eio_main.mli: -------------------------------------------------------------------------------- 1 | (** Select a suitable event loop for Eio. *) 2 | 3 | val run : (Eio.Stdenv.t -> 'a) -> 'a 4 | (** [run fn] runs an event loop and then calls [fn env] within it. 5 | 6 | [env] provides access to the process's environment (file-system, network, etc). 7 | 8 | When [fn] ends, the event loop finishes. 9 | 10 | This should be called once, at the entry point of an application. 11 | It {b must not} be called by libraries. 12 | Doing so would force the library to depend on Unix 13 | (making it unusable from unikernels or browsers), 14 | prevent the user from choosing their own event loop, 15 | and prevent using the library with other Eio libraries. 16 | 17 | [run] will select an appropriate event loop for the current platform. 18 | On many systems, it will use {!Eio_luv.run}. 19 | 20 | On recent-enough versions of Linux, it will use {!Eio_linux.run}. 21 | You can override this by setting the $EIO_BACKEND environment variable to 22 | either "io-uring" or "luv". *) 23 | -------------------------------------------------------------------------------- /lib_eio/utils/zzz.mli: -------------------------------------------------------------------------------- 1 | (** A set of timers. *) 2 | 3 | (** A handle to a registered timer. *) 4 | module Key : sig 5 | type t 6 | end 7 | 8 | type t 9 | (** A set of timers (implemented as a priority queue). *) 10 | 11 | val create : unit -> t 12 | (** [create ()] is a fresh empty queue. *) 13 | 14 | val add : t -> float -> unit Suspended.t -> Key.t 15 | (** [add t time thread] adds a new event, due at [time], and returns its ID. 16 | You must use {!Eio.Private.Fiber_context.set_cancel_fn} on [thread] before 17 | calling {!pop}. 18 | Your cancel function should call {!remove} (in addition to resuming [thread]). *) 19 | 20 | val remove : t -> Key.t -> unit 21 | (** [remove t key] removes an event previously added with [add]. *) 22 | 23 | val pop : t -> now:float -> [`Due of unit Suspended.t | `Wait_until of float | `Nothing] 24 | (** [pop ~now t] removes and returns the earliest thread due by [now]. 25 | It also clears the thread's cancel function. 26 | If no thread is due yet, it returns the time the earliest thread becomes due. *) 27 | -------------------------------------------------------------------------------- /eio_main.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "Effect-based direct-style IO mainloop for OCaml" 4 | description: "Selects an appropriate Eio backend for the current platform." 5 | maintainer: ["anil@recoil.org"] 6 | authors: ["Anil Madhavapeddy" "Thomas Leonard"] 7 | license: "ISC" 8 | homepage: "https://github.com/ocaml-multicore/eio" 9 | doc: "https://ocaml-multicore.github.io/eio/" 10 | bug-reports: "https://github.com/ocaml-multicore/eio/issues" 11 | depends: [ 12 | "dune" {>= "2.9"} 13 | "eio_linux" {= version & os = "linux"} 14 | "mdx" {>= "1.10.0" & with-test} 15 | "eio_luv" {= version} 16 | "odoc" {with-doc} 17 | ] 18 | build: [ 19 | ["dune" "subst"] {dev} 20 | [ 21 | "dune" 22 | "build" 23 | "-p" 24 | name 25 | "-j" 26 | jobs 27 | "--promote-install-files=false" 28 | "@install" 29 | "@runtest" {with-test} 30 | "@doc" {with-doc} 31 | ] 32 | ["dune" "install" "-p" name "--create-install-files" name] 33 | ] 34 | dev-repo: "git+https://github.com/ocaml-multicore/eio.git" 35 | -------------------------------------------------------------------------------- /lib_eio/core/exn.ml: -------------------------------------------------------------------------------- 1 | type with_bt = exn * Printexc.raw_backtrace 2 | 3 | exception Multiple of exn list (* Note: the last exception in list is the first one reported *) 4 | 5 | exception Cancelled of exn 6 | 7 | exception Cancel_hook_failed of exn list 8 | 9 | let () = 10 | Printexc.register_printer @@ function 11 | | Multiple exns -> Some ("Multiple exceptions:\n" ^ String.concat "\nand\n" (List.rev_map Printexc.to_string exns)) 12 | | Cancel_hook_failed exns -> Some ("During cancellation:\n" ^ String.concat "\nand\n" (List.map Printexc.to_string exns)) 13 | | Cancelled ex -> Some ("Cancelled: " ^ Printexc.to_string ex) 14 | | _ -> None 15 | 16 | let combine e1 e2 = 17 | if fst e1 == fst e2 then e1 18 | else match e1, e2 with 19 | | (Cancelled _, _), e 20 | | e, (Cancelled _, _) -> e (* Don't need to report a cancelled exception if we have something better *) 21 | | (Multiple exs, _), _ when List.memq (fst e2) exs -> e1 (* Avoid duplicates *) 22 | | (Multiple exs, bt1), (e2, _) -> Multiple (e2 :: exs), bt1 23 | | (e1, bt1), (e2, _) -> Multiple [e2; e1], bt1 24 | -------------------------------------------------------------------------------- /eio_luv.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "Eio implementation using luv (libuv)" 4 | description: "An eio implementation for most platforms, using luv." 5 | maintainer: ["anil@recoil.org"] 6 | authors: ["Anil Madhavapeddy" "Thomas Leonard"] 7 | license: "ISC" 8 | homepage: "https://github.com/ocaml-multicore/eio" 9 | doc: "https://ocaml-multicore.github.io/eio/" 10 | bug-reports: "https://github.com/ocaml-multicore/eio/issues" 11 | depends: [ 12 | "dune" {>= "2.9"} 13 | "eio" {= version} 14 | "luv" {>= "0.5.11"} 15 | "luv_unix" {>= "0.5.0"} 16 | "mdx" {>= "1.10.0" & with-test} 17 | "logs" {>= "0.7.0"} 18 | "fmt" {>= "0.8.9"} 19 | "odoc" {with-doc} 20 | ] 21 | build: [ 22 | ["dune" "subst"] {dev} 23 | [ 24 | "dune" 25 | "build" 26 | "-p" 27 | name 28 | "-j" 29 | jobs 30 | "--promote-install-files=false" 31 | "@install" 32 | "@runtest" {with-test} 33 | "@doc" {with-doc} 34 | ] 35 | ["dune" "install" "-p" name "--create-install-files" name] 36 | ] 37 | dev-repo: "git+https://github.com/ocaml-multicore/eio.git" 38 | -------------------------------------------------------------------------------- /bench/bench_yield.ml: -------------------------------------------------------------------------------- 1 | open Eio.Std 2 | 3 | let n_fibers = [1; 2; 3; 4; 5; 10; 20; 30; 40; 50; 100; 500; 1000; 10000] 4 | 5 | let main ~clock = 6 | Printf.printf "n_fibers, ns/iter, promoted/iter\n%!"; 7 | n_fibers |> List.iter (fun n_fibers -> 8 | let n_iters = 1000000 / n_fibers in 9 | Gc.full_major (); 10 | let _minor0, prom0, _major0 = Gc.counters () in 11 | let t0 = Eio.Time.now clock in 12 | Switch.run (fun sw -> 13 | for _ = 1 to n_fibers do 14 | Fiber.fork ~sw (fun () -> 15 | for _ = 1 to n_iters do 16 | Fiber.yield () 17 | done 18 | ) 19 | done 20 | ); 21 | let t1 = Eio.Time.now clock in 22 | let time_total = t1 -. t0 in 23 | let n_total = n_fibers * n_iters in 24 | let time_per_iter = time_total /. float n_total in 25 | let _minor1, prom1, _major1 = Gc.counters () in 26 | let prom = prom1 -. prom0 in 27 | Printf.printf "%8d, % 7.2f, % 13.4f\n%!" n_fibers (1e9 *. time_per_iter) (prom /. float n_total) 28 | ) 29 | 30 | let () = 31 | Eio_main.run @@ fun env -> 32 | main ~clock:(Eio.Stdenv.clock env) 33 | -------------------------------------------------------------------------------- /eio_linux.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "Eio implementation for Linux using io-uring" 4 | description: "An eio implementation for Linux using io-uring." 5 | maintainer: ["anil@recoil.org"] 6 | authors: ["Anil Madhavapeddy" "Thomas Leonard"] 7 | license: "ISC" 8 | homepage: "https://github.com/ocaml-multicore/eio" 9 | doc: "https://ocaml-multicore.github.io/eio/" 10 | bug-reports: "https://github.com/ocaml-multicore/eio/issues" 11 | depends: [ 12 | "dune" {>= "2.9"} 13 | "alcotest" {>= "1.4.0" & with-test} 14 | "eio" {= version} 15 | "mdx" {>= "1.10.0" & with-test} 16 | "logs" {>= "0.7.0"} 17 | "fmt" {>= "0.8.9"} 18 | "cmdliner" {>= "1.1.0" & with-test} 19 | "uring" {>= "0.4"} 20 | "odoc" {with-doc} 21 | ] 22 | build: [ 23 | ["dune" "subst"] {dev} 24 | [ 25 | "dune" 26 | "build" 27 | "-p" 28 | name 29 | "-j" 30 | jobs 31 | "--promote-install-files=false" 32 | "@install" 33 | "@runtest" {with-test} 34 | "@doc" {with-doc} 35 | ] 36 | ["dune" "install" "-p" name "--create-install-files" name] 37 | ] 38 | dev-repo: "git+https://github.com/ocaml-multicore/eio.git" 39 | -------------------------------------------------------------------------------- /lib_eio/semaphore.mli: -------------------------------------------------------------------------------- 1 | (** The API is based on OCaml's [Semaphore.Counting]. 2 | 3 | The difference is that when waiting for the semaphore this will switch to the next runnable fiber, 4 | whereas the stdlib one will block the whole domain. 5 | 6 | Semaphores are thread-safe and so can be shared between domains and used 7 | to synchronise between them. *) 8 | 9 | type t 10 | (** The type of counting semaphores. *) 11 | 12 | val make : int -> t 13 | (** [make n] returns a new counting semaphore, with initial value [n]. 14 | The initial value [n] must be nonnegative. 15 | @raise Invalid_argument if [n < 0] *) 16 | 17 | val release : t -> unit 18 | (** [release t] increments the value of semaphore [t]. 19 | If other fibers are waiting on [t], the one that has been waiting the longest is resumed. 20 | @raise Sys_error if the value of the semaphore would overflow [max_int] *) 21 | 22 | val acquire : t -> unit 23 | (** [acquire t] blocks the calling fiber until the value of semaphore [t] 24 | is not zero, then atomically decrements the value of [t] and returns. *) 25 | 26 | val get_value : t -> int 27 | (** [get_value t] returns the current value of semaphore [t]. *) 28 | -------------------------------------------------------------------------------- /lib_eio_linux/tests/bench_noop.ml: -------------------------------------------------------------------------------- 1 | open Eio.Std 2 | 3 | let n_fibers = [1; 2; 3; 4; 5; 10; 20; 30; 40; 50; 100; 500; 1000; 10000] 4 | 5 | let main ~clock = 6 | Printf.printf "n_fibers, ns/iter, promoted/iter\n%!"; 7 | n_fibers |> List.iter (fun n_fibers -> 8 | let n_iters = 1000000 / n_fibers in 9 | Gc.full_major (); 10 | let _minor0, prom0, _major0 = Gc.counters () in 11 | let t0 = Eio.Time.now clock in 12 | Switch.run (fun sw -> 13 | for _ = 1 to n_fibers do 14 | Fiber.fork ~sw (fun () -> 15 | for _ = 1 to n_iters do 16 | Eio_linux.Low_level.noop () 17 | done 18 | ) 19 | done 20 | ); 21 | let t1 = Eio.Time.now clock in 22 | let time_total = t1 -. t0 in 23 | let n_total = n_fibers * n_iters in 24 | let time_per_iter = time_total /. float n_total in 25 | let _minor1, prom1, _major1 = Gc.counters () in 26 | let prom = prom1 -. prom0 in 27 | Printf.printf "%5d, %.2f, %7.4f\n%!" n_fibers (1e9 *. time_per_iter) (prom /. float n_total) 28 | ) 29 | 30 | let () = 31 | Eio_linux.run @@ fun env -> 32 | main ~clock:(Eio.Stdenv.clock env) 33 | -------------------------------------------------------------------------------- /lib_eio_linux/tests/basic_eio_linux.ml: -------------------------------------------------------------------------------- 1 | (* basic tests using effects *) 2 | 3 | open Eio_linux.Low_level 4 | open Eio.Std 5 | module Int63 = Optint.Int63 6 | 7 | let setup_log level = 8 | Fmt_tty.setup_std_outputs (); 9 | Logs.set_level level; 10 | Logs.set_reporter (Logs_fmt.reporter ()) 11 | 12 | let () = 13 | setup_log (Some Logs.Debug); 14 | Eio_linux.run @@ fun _stdenv -> 15 | Switch.run @@ fun sw -> 16 | let fd = Unix.handle_unix_error (openfile ~sw "test.txt" Unix.[O_RDONLY]) 0 in 17 | let buf = alloc_fixed_or_wait () in 18 | let _ = read_exactly fd buf 5 in 19 | print_endline (Uring.Region.to_string ~len:5 buf); 20 | let _ = read_exactly fd ~file_offset:(Int63.of_int 3) buf 3 in 21 | print_endline (Uring.Region.to_string ~len:3 buf); 22 | free_fixed buf; 23 | (* With a sleep: *) 24 | let buf = alloc_fixed_or_wait () in 25 | let _ = read_exactly fd buf 5 in 26 | Logs.debug (fun l -> l "sleeping at %f" (Unix.gettimeofday ())); 27 | sleep_until (Unix.gettimeofday () +. 1.0); 28 | print_endline (Uring.Region.to_string ~len:5 buf); 29 | let _ = read_exactly fd ~file_offset:(Int63.of_int 3) buf 3 in 30 | print_endline (Uring.Region.to_string ~len:3 buf); 31 | free_fixed buf 32 | -------------------------------------------------------------------------------- /stress/stress_semaphore.ml: -------------------------------------------------------------------------------- 1 | open Eio.Std 2 | 3 | (* Three domains fighting over 2 semaphore tokens, 4 | with domains cancelling if they don't get served quickly. *) 5 | 6 | let n_domains = 3 7 | let n_tokens = 2 8 | let n_iters = 100_000 9 | 10 | let main ~domain_mgr = 11 | let sem = Eio.Semaphore.make n_tokens in 12 | Switch.run (fun sw -> 13 | for _ = 1 to n_domains do 14 | Fiber.fork ~sw (fun () -> 15 | Eio.Domain_manager.run domain_mgr (fun () -> 16 | let i = ref 0 in 17 | while !i < n_iters do 18 | let got = ref false in 19 | Fiber.first 20 | (fun () -> Eio.Semaphore.acquire sem; got := true) 21 | (fun () -> Fiber.yield ()); 22 | if !got then ( 23 | incr i; 24 | Eio.Semaphore.release sem; 25 | ) else ( 26 | (* traceln "yield" *) 27 | ) 28 | done 29 | ) 30 | ) 31 | done; 32 | ); 33 | assert (Eio.Semaphore.get_value sem = n_tokens); 34 | print_endline "OK" 35 | 36 | let () = 37 | Eio_main.run @@ fun env -> 38 | main ~domain_mgr:(Eio.Stdenv.domain_mgr env) 39 | -------------------------------------------------------------------------------- /lib_main/eio_main.linux.ml: -------------------------------------------------------------------------------- 1 | let has_working_uring v = 2 | (* Note: if you change this, remember to change the log message below too *) 3 | match String.split_on_char '.' v with 4 | | "5" :: minor :: _ -> int_of_string minor >= 11 5 | | major :: _ -> int_of_string major > 5 6 | | [] -> false 7 | 8 | let run_io_uring ?fallback fn = 9 | Logs.info (fun f -> f "Selecting io-uring backend"); 10 | Eio_linux.run ?fallback (fun env -> fn (env :> Eio.Stdenv.t)) 11 | 12 | let run_luv fn = 13 | Eio_luv.run (fun env -> fn (env :> Eio.Stdenv.t)) 14 | 15 | let run fn = 16 | match Sys.getenv_opt "EIO_BACKEND" with 17 | | Some "io-uring" -> run_io_uring fn 18 | | Some "luv" -> 19 | Logs.info (fun f -> f "Using luv backend"); 20 | run_luv fn 21 | | None | Some "" -> 22 | begin match Luv.System_info.uname () with 23 | | Ok x when has_working_uring x.release -> 24 | run_io_uring fn 25 | ~fallback:(fun (`Msg msg) -> 26 | Logs.info (fun f -> f "%s; using luv backend instead" msg); 27 | run_luv fn 28 | ) 29 | | _ -> 30 | Logs.info (fun f -> f "Selecting luv backend (io-uring needs Linux >= 5.11)"); 31 | run_luv fn 32 | end 33 | | Some x -> Fmt.failwith "Unknown eio backend %S (from $EIO_BACKEND)" x 34 | -------------------------------------------------------------------------------- /lib_eio/core/debug.ml: -------------------------------------------------------------------------------- 1 | type traceln = { 2 | traceln : 'a. ?__POS__:string * int * int * int -> ('a, Format.formatter, unit, unit) format4 -> 'a; 3 | } [@@unboxed] 4 | 5 | let traceln_key : traceln Fiber.key = Fiber.create_key () 6 | 7 | let traceln_mutex = Mutex.create () 8 | 9 | let default_traceln ?__POS__:pos fmt = 10 | let k go = 11 | let b = Buffer.create 512 in 12 | let f = Format.formatter_of_buffer b in 13 | go f; 14 | Option.iter (fun (file, lnum, _, _) -> Format.fprintf f " [%s:%d]" file lnum) pos; 15 | Format.pp_close_box f (); 16 | Format.pp_print_flush f (); 17 | let msg = Buffer.contents b in 18 | Ctf.label msg; 19 | let lines = String.split_on_char '\n' msg in 20 | Mutex.lock traceln_mutex; 21 | Fun.protect ~finally:(fun () -> Mutex.unlock traceln_mutex) @@ fun () -> 22 | List.iter (Printf.eprintf "+%s\n") lines; 23 | flush stderr 24 | in 25 | Format.kdprintf k ("@[" ^^ fmt) 26 | 27 | let traceln ?__POS__ fmt = 28 | let traceln = 29 | match Fiber.get traceln_key with 30 | | Some { traceln } -> traceln 31 | | None 32 | | exception Unhandled -> default_traceln 33 | in 34 | traceln ?__POS__ fmt 35 | 36 | type t = < 37 | traceln : traceln Fiber.key; 38 | > 39 | 40 | let v = object 41 | method traceln = traceln_key 42 | end 43 | -------------------------------------------------------------------------------- /eio.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "Effect-based direct-style IO API for OCaml" 4 | description: "An effect-based IO API for multicore OCaml with fibers." 5 | maintainer: ["anil@recoil.org"] 6 | authors: ["Anil Madhavapeddy" "Thomas Leonard"] 7 | license: "ISC" 8 | homepage: "https://github.com/ocaml-multicore/eio" 9 | doc: "https://ocaml-multicore.github.io/eio/" 10 | bug-reports: "https://github.com/ocaml-multicore/eio/issues" 11 | depends: [ 12 | "dune" {>= "2.9"} 13 | "ocaml" {>= "5.0.0"} 14 | "bigstringaf" {>= "0.9.0"} 15 | "cstruct" {>= "6.0.1"} 16 | "lwt-dllist" 17 | "optint" {>= "0.1.0"} 18 | "psq" {>= "0.2.0"} 19 | "fmt" {>= "0.8.9"} 20 | "hmap" {>= "0.8.1"} 21 | "astring" {>= "0.8.5" & with-test} 22 | "crowbar" {>= "0.2" & with-test} 23 | "mtime" {>= "1.2.0"} 24 | "alcotest" {>= "1.4.0" & with-test} 25 | "odoc" {with-doc} 26 | ] 27 | build: [ 28 | ["dune" "subst"] {dev} 29 | [ 30 | "dune" 31 | "build" 32 | "-p" 33 | name 34 | "-j" 35 | jobs 36 | "--promote-install-files=false" 37 | "@install" 38 | "@runtest" {with-test} 39 | "@doc" {with-doc} 40 | ] 41 | ["dune" "install" "-p" name "--create-install-files" name] 42 | ] 43 | dev-repo: "git+https://github.com/ocaml-multicore/eio.git" 44 | -------------------------------------------------------------------------------- /lib_eio/utils/zzz.ml: -------------------------------------------------------------------------------- 1 | module Key = struct 2 | type t = Optint.Int63.t 3 | let compare = Optint.Int63.compare 4 | end 5 | 6 | module Job = struct 7 | type t = { 8 | time : float; 9 | thread : unit Suspended.t; 10 | } 11 | 12 | let compare a b = Float.compare a.time b.time 13 | end 14 | 15 | module Q = Psq.Make(Key)(Job) 16 | 17 | type t = { 18 | mutable sleep_queue: Q.t; 19 | mutable next_id : Optint.Int63.t; 20 | } 21 | 22 | let create () = { sleep_queue = Q.empty; next_id = Optint.Int63.zero } 23 | 24 | let add t time thread = 25 | let id = t.next_id in 26 | t.next_id <- Optint.Int63.succ t.next_id; 27 | let sleeper = { Job.time; thread } in 28 | t.sleep_queue <- Q.add id sleeper t.sleep_queue; 29 | id 30 | 31 | let remove t id = 32 | t.sleep_queue <- Q.remove id t.sleep_queue 33 | 34 | let pop t ~now = 35 | match Q.min t.sleep_queue with 36 | | Some (_, { Job.time; thread }) when time <= now -> 37 | if Eio.Private.Fiber_context.clear_cancel_fn thread.fiber then ( 38 | t.sleep_queue <- Option.get (Q.rest t.sleep_queue); 39 | `Due thread 40 | ) else ( 41 | (* This shouldn't happen, since any cancellation will happen in the same domain as the [pop]. *) 42 | assert false 43 | ) 44 | | Some (_, { Job.time; _ }) -> `Wait_until time 45 | | None -> `Nothing 46 | -------------------------------------------------------------------------------- /lib_eio/utils/lf_queue.mli: -------------------------------------------------------------------------------- 1 | (** A lock-free multi-producer, single-consumer, thread-safe queue without support for cancellation. 2 | This makes a good data structure for a scheduler's run queue. *) 3 | 4 | type 'a t 5 | (** A queue of items of type ['a]. *) 6 | 7 | exception Closed 8 | 9 | val create : unit -> 'a t 10 | (** [create ()] is a new empty queue. *) 11 | 12 | val push : 'a t -> 'a -> unit 13 | (** [push t x] adds [x] to the tail of the queue. 14 | This can be used safely by multiple producer domains, in parallel with the other operations. 15 | @raise Closed if [t] is closed. *) 16 | 17 | val push_head : 'a t -> 'a -> unit 18 | (** [push_head t x] inserts [x] at the head of the queue. 19 | This can only be used by the consumer (if run in parallel with {!pop}, the item might be skipped). 20 | @raise Closed if [t] is closed and empty. *) 21 | 22 | val pop : 'a t -> 'a option 23 | (** [pop t] removes the head item from [t] and returns it. 24 | Returns [None] if [t] is currently empty. 25 | @raise Closed if [t] has been closed and is empty. *) 26 | 27 | val is_empty : 'a t -> bool 28 | (** [is_empty t] is [true] if calling [pop] would return [None]. 29 | @raise Closed if [t] has been closed and is empty. *) 30 | 31 | val close : 'a t -> unit 32 | (** [close t] marks [t] as closed, preventing any further items from being pushed. *) 33 | -------------------------------------------------------------------------------- /lib_eio_linux/tests/fd_passing.md: -------------------------------------------------------------------------------- 1 | # Setting up the environment 2 | 3 | ```ocaml 4 | # #require "eio_linux";; 5 | ``` 6 | 7 | ```ocaml 8 | open Eio.Std 9 | 10 | let ( / ) = Eio.Path.( / ) 11 | ``` 12 | 13 | Sending a file descriptor over a Unix domain socket: 14 | 15 | ```ocaml 16 | # Eio_linux.run @@ fun env -> 17 | Switch.run @@ fun sw -> 18 | let fd = Eio.Path.open_out ~sw (env#cwd / "tmp.txt") ~create:(`Exclusive 0o600) in 19 | Eio.Flow.copy_string "Test data" fd; 20 | let r, w = Unix.(socketpair PF_UNIX SOCK_STREAM 0) in 21 | let r = Eio_linux.FD.of_unix ~sw ~seekable:false ~close_unix:true r in 22 | let w = Eio_linux.FD.of_unix ~sw ~seekable:false ~close_unix:true w in 23 | Fiber.both 24 | (fun () -> Eio_linux.Low_level.send_msg w [Cstruct.of_string "x"] ~fds:[Eio_linux.get_fd_opt fd |> Option.get]) 25 | (fun () -> 26 | let buf = Cstruct.of_string "?" in 27 | let addr, got, fds = Eio_linux.Low_level.recv_msg_with_fds ~sw r ~max_fds:10 [buf] in 28 | traceln "Got: %S plus %d FD" (Cstruct.to_string buf) (List.length fds); 29 | match fds with 30 | | [fd] -> 31 | let fd = Eio_linux.FD.to_unix `Peek fd in 32 | ignore (Unix.lseek fd 0 Unix.SEEK_SET : int); 33 | traceln "Read: %S" (really_input_string (Unix.in_channel_of_descr fd) 9); 34 | | _ -> assert false 35 | );; 36 | +Got: "x" plus 1 FD 37 | +Read: "Test data" 38 | - : unit = () 39 | ``` 40 | -------------------------------------------------------------------------------- /lib_eio/domain_manager.ml: -------------------------------------------------------------------------------- 1 | open Effect 2 | 3 | class virtual t = object 4 | method virtual run : 'a. (unit -> 'a) -> 'a 5 | method virtual run_raw : 'a. (unit -> 'a) -> 'a 6 | end 7 | 8 | let run_raw (t : #t) = t#run_raw 9 | 10 | let run (t : #t) fn = 11 | let ctx = perform Private.Effects.Get_context in 12 | Cancel.check (Private.Fiber_context.cancellation_context ctx); 13 | let cancelled, set_cancelled = Promise.create () in 14 | Private.Fiber_context.set_cancel_fn ctx (Promise.resolve set_cancelled); 15 | (* If the spawning fiber is cancelled, [cancelled] gets set to the exception. *) 16 | match 17 | t#run @@ fun () -> 18 | Fiber.first 19 | (fun () -> 20 | match Promise.await cancelled with 21 | | Cancel.Cancelled ex -> raise ex (* To avoid [Cancelled (Cancelled ex))] *) 22 | | ex -> raise ex (* Shouldn't happen *) 23 | ) 24 | fn 25 | with 26 | | x -> 27 | ignore (Private.Fiber_context.clear_cancel_fn ctx : bool); 28 | x 29 | | exception ex -> 30 | ignore (Private.Fiber_context.clear_cancel_fn ctx : bool); 31 | match Promise.peek cancelled with 32 | | Some (Cancel.Cancelled ex2 as cex) when ex == ex2 -> 33 | (* We unwrapped the exception above to avoid a double cancelled exception. 34 | But this means that the top-level reported the original exception, 35 | which isn't what we want. *) 36 | raise cex 37 | | _ -> raise ex 38 | -------------------------------------------------------------------------------- /doc/prelude.ml: -------------------------------------------------------------------------------- 1 | #require "eio_main";; 2 | 3 | module Eio_main = struct 4 | open Eio.Std 5 | 6 | let now = ref 1623940778.27033591 7 | 8 | let fake_clock real_clock = object (_ : #Eio.Time.clock) 9 | method now = !now 10 | method sleep_until time = 11 | (* The fake times are all in the past, so we just ask to wait until the 12 | fake time is due and it will happen immediately. If we wait for 13 | multiple times, they'll get woken in the right order. At the moment, 14 | the scheduler only checks for expired timers when the run-queue is 15 | empty, so this is a convenient way to wait for the system to be idle. 16 | TODO: This is no longer true (since #213). *) 17 | Eio.Time.sleep_until real_clock time; 18 | now := max !now time 19 | end 20 | 21 | (* To avoid non-deterministic output, we run the examples a single domain. *) 22 | let fake_domain_mgr = object (_ : #Eio.Domain_manager.t) 23 | method run fn = fn () 24 | method run_raw fn = fn () 25 | end 26 | 27 | let run fn = 28 | Eio_main.run @@ fun env -> 29 | fn @@ object 30 | method net = env#net 31 | method stdin = env#stdin 32 | method stdout = env#stdout 33 | method cwd = env#cwd 34 | method domain_mgr = fake_domain_mgr 35 | method clock = fake_clock env#clock 36 | end 37 | end 38 | 39 | let parse_config (flow : #Eio.Flow.source) = ignore 40 | -------------------------------------------------------------------------------- /lib_eio/semaphore.ml: -------------------------------------------------------------------------------- 1 | type state = 2 | | Free of int 3 | | Waiting of unit Waiters.t 4 | 5 | type t = { 6 | id : Ctf.id; 7 | mutex : Mutex.t; 8 | mutable state : state; 9 | } 10 | 11 | let make n = 12 | if n < 0 then raise (Invalid_argument "n < 0"); 13 | let id = Ctf.mint_id () in 14 | Ctf.note_created id Ctf.Semaphore; 15 | { 16 | id; 17 | mutex = Mutex.create (); 18 | state = Free n; 19 | } 20 | 21 | let release t = 22 | Mutex.lock t.mutex; 23 | Ctf.note_signal t.id; 24 | match t.state with 25 | | Free x when x = max_int -> Mutex.unlock t.mutex; raise (Sys_error "semaphore would overflow max_int!") 26 | | Free x -> t.state <- Free (succ x); Mutex.unlock t.mutex 27 | | Waiting q -> 28 | begin match Waiters.wake_one q () with 29 | | `Ok -> () 30 | | `Queue_empty -> t.state <- Free 1 31 | end; 32 | Mutex.unlock t.mutex 33 | 34 | let rec acquire t = 35 | Mutex.lock t.mutex; 36 | match t.state with 37 | | Waiting q -> 38 | Ctf.note_try_read t.id; 39 | Waiters.await ~mutex:(Some t.mutex) q t.id 40 | | Free 0 -> 41 | t.state <- Waiting (Waiters.create ()); 42 | Mutex.unlock t.mutex; 43 | acquire t 44 | | Free n -> 45 | Ctf.note_read t.id; 46 | t.state <- Free (pred n); 47 | Mutex.unlock t.mutex 48 | 49 | let get_value t = 50 | Mutex.lock t.mutex; 51 | let s = t.state in 52 | Mutex.unlock t.mutex; 53 | match s with 54 | | Free n -> n 55 | | Waiting _ -> 0 56 | -------------------------------------------------------------------------------- /lib_eio_linux/tests/eurcp.ml: -------------------------------------------------------------------------------- 1 | let setup_log style_renderer level = 2 | Fmt_tty.setup_std_outputs ?style_renderer (); 3 | Logs.set_level level; 4 | Logs.set_reporter (Logs_fmt.reporter ()) 5 | 6 | open Cmdliner 7 | 8 | let cmd = 9 | let setup_log = 10 | Term.(const setup_log $ Fmt_cli.style_renderer () $ Logs_cli.level ()) in 11 | let infile = 12 | let doc = "Source filename to copy from" in 13 | Arg.(required & pos 0 (some file) None & info [] ~docv:"SOURCE_FILE" ~doc) in 14 | let outfile = 15 | let doc = "Target filename to copy to" in 16 | Arg.(required & pos 1 (some string) None & info [] ~docv:"TARGET_FILE" ~doc) in 17 | let block_size = 18 | let doc = "Block size per chunk in bytes" in 19 | Arg.(value & opt int (32 * 1024) & info ["block-size"] ~docv:"BYTES" ~doc) in 20 | let queue_depth = 21 | let doc = "Number of async requests in parallel" in 22 | Arg.(value & opt int 64 & info ["queue-depth"] ~docv:"ENTRIES" ~doc) in 23 | let doc = "copy a file using async effect-based io_uring" in 24 | let man = 25 | [ 26 | `S "DESCRIPTION"; 27 | `P "$(tname) copies a file using Linux io_uring."; 28 | ] 29 | in 30 | let info = Cmd.info "eurcp" ~version:"1.0.0" ~doc ~man in 31 | Cmd.v info Term.(const Eurcp_lib.run_cp $ block_size $ queue_depth $ infile $ outfile $ setup_log) 32 | 33 | let () = 34 | match Cmd.eval cmd with 35 | | 0 -> exit (if Logs.err_count () > 0 then 1 else 0) 36 | | _ -> exit 1 37 | -------------------------------------------------------------------------------- /lib_eio/eio.ml: -------------------------------------------------------------------------------- 1 | include Eio__core 2 | 3 | module Fibre = Fiber 4 | 5 | module Debug = Private.Debug 6 | let traceln = Debug.traceln 7 | 8 | module Std = struct 9 | module Promise = Promise 10 | module Fiber = Fiber 11 | module Fibre = Fiber 12 | module Switch = Switch 13 | let traceln = Debug.traceln 14 | end 15 | 16 | module Semaphore = Semaphore 17 | module Mutex = Eio_mutex 18 | module Condition = Condition 19 | module Stream = Stream 20 | module Exn = Exn 21 | module Generic = Generic 22 | module Flow = Flow 23 | module Buf_read = Buf_read 24 | module Buf_write = Buf_write 25 | module Net = Net 26 | module Domain_manager = Domain_manager 27 | module Time = Time 28 | module Fs = Fs 29 | module Path = Path 30 | 31 | module Stdenv = struct 32 | type t = < 33 | stdin : Flow.source; 34 | stdout : Flow.sink; 35 | stderr : Flow.sink; 36 | net : Net.t; 37 | domain_mgr : Domain_manager.t; 38 | clock : Time.clock; 39 | fs : Fs.dir Path.t; 40 | cwd : Fs.dir Path.t; 41 | secure_random : Flow.source; 42 | debug : Debug.t; 43 | > 44 | 45 | let stdin (t : ) = t#stdin 46 | let stdout (t : ) = t#stdout 47 | let stderr (t : ) = t#stderr 48 | let net (t : ) = t#net 49 | let domain_mgr (t : ) = t#domain_mgr 50 | let clock (t : ) = t#clock 51 | let secure_random (t: ) = t#secure_random 52 | let fs (t : ) = t#fs 53 | let cwd (t : ) = t#cwd 54 | let debug (t : ) = t#debug 55 | end 56 | -------------------------------------------------------------------------------- /lib_eio/path.ml: -------------------------------------------------------------------------------- 1 | type 'a t = (#Fs.dir as 'a) * Fs.path 2 | 3 | let ( / ) (dir, p1) p2 = 4 | match p1, p2 with 5 | | p1, "" -> (dir, Filename.concat p1 p2) 6 | | _, p2 when not (Filename.is_relative p2) -> (dir, p2) 7 | | ".", p2 -> (dir, p2) 8 | | p1, p2 -> (dir, Filename.concat p1 p2) 9 | 10 | let pp f ((t:#Fs.dir), p) = 11 | Fmt.pf f "<%t:%s>" t#pp (String.escaped p) 12 | 13 | let open_in ~sw ((t:#Fs.dir), path) = t#open_in ~sw path 14 | let open_out ~sw ?(append=false) ~create ((t:#Fs.dir), path) = t#open_out ~sw ~append ~create path 15 | let open_dir ~sw ((t:#Fs.dir), path) = (t#open_dir ~sw path, "") 16 | let mkdir ~perm ((t:#Fs.dir), path) = t#mkdir ~perm path 17 | let read_dir ((t:#Fs.dir), path) = List.sort String.compare (t#read_dir path) 18 | 19 | let with_open_in path fn = 20 | Switch.run @@ fun sw -> fn (open_in ~sw path) 21 | 22 | let with_open_out ?append ~create path fn = 23 | Switch.run @@ fun sw -> fn (open_out ~sw ?append ~create path) 24 | 25 | let with_open_dir path fn = 26 | Switch.run @@ fun sw -> fn (open_dir ~sw path) 27 | 28 | let with_lines path fn = 29 | with_open_in path @@ fun flow -> 30 | let buf = Buf_read.of_flow flow ~max_size:max_int in 31 | fn (Buf_read.lines buf) 32 | 33 | let load path = 34 | with_open_in path @@ fun flow -> 35 | let buf = Buf_read.of_flow flow ~max_size:max_int in 36 | Buf_read.take_all buf 37 | 38 | let save ?append ~create path data = 39 | with_open_out ?append ~create path @@ fun flow -> 40 | Flow.copy_string data flow 41 | 42 | let unlink ((t:#Fs.dir), path) = t#unlink path 43 | let rmdir ((t:#Fs.dir), path) = t#rmdir path 44 | let rename ((t1:#Fs.dir), old_path) (t2, new_path) = t1#rename old_path (t2 :> Fs.dir) new_path 45 | -------------------------------------------------------------------------------- /bench/bench_stream.ml: -------------------------------------------------------------------------------- 1 | open Eio.Std 2 | 3 | let run_sender ~n_iters stream = 4 | for i = 1 to n_iters do 5 | Eio.Stream.add stream i 6 | done 7 | 8 | let run_bench ~domain_mgr ~clock ~use_domains ~n_iters ~capacity = 9 | let stream = Eio.Stream.create capacity in 10 | Gc.full_major (); 11 | let _minor0, prom0, _major0 = Gc.counters () in 12 | let t0 = Eio.Time.now clock in 13 | Fiber.both 14 | (fun () -> 15 | if use_domains then ( 16 | Eio.Domain_manager.run domain_mgr @@ fun () -> 17 | run_sender ~n_iters stream 18 | ) else ( 19 | run_sender ~n_iters stream 20 | ) 21 | ) 22 | (fun () -> 23 | for i = 1 to n_iters do 24 | let j = Eio.Stream.take stream in 25 | assert (i = j) 26 | done 27 | ); 28 | let t1 = Eio.Time.now clock in 29 | let time_total = t1 -. t0 in 30 | let time_per_iter = time_total /. float n_iters in 31 | let _minor1, prom1, _major1 = Gc.counters () in 32 | let prom = prom1 -. prom0 in 33 | Printf.printf "%11b, %8d, %8d, %7.2f, %13.4f\n%!" use_domains n_iters capacity (1e9 *. time_per_iter) (prom /. float n_iters) 34 | 35 | let main ~domain_mgr ~clock = 36 | Printf.printf "use_domains, n_iters, capacity, ns/iter, promoted/iter\n%!"; 37 | [false, 10_000_000; 38 | true, 1_000_000] 39 | |> List.iter (fun (use_domains, n_iters) -> 40 | [0; 1; 10; 100; 1000] |> List.iter (fun capacity -> 41 | run_bench ~domain_mgr ~clock ~use_domains ~n_iters ~capacity 42 | ) 43 | ) 44 | 45 | let () = 46 | Eio_main.run @@ fun env -> 47 | main 48 | ~domain_mgr:(Eio.Stdenv.domain_mgr env) 49 | ~clock:(Eio.Stdenv.clock env) 50 | -------------------------------------------------------------------------------- /lib_eio/stream.mli: -------------------------------------------------------------------------------- 1 | (** Reading from an empty queue will wait until an item is available. 2 | Writing to a full queue will wait until there is space. 3 | 4 | Example: 5 | {[ 6 | let t = Stream.create 100 in 7 | Stream.add t 1; 8 | Stream.add t 2; 9 | assert (Stream.take t = 1); 10 | assert (Stream.take t = 2) 11 | ]} 12 | 13 | Streams are thread-safe and so can be shared between domains and used 14 | to communicate between them. *) 15 | 16 | type 'a t 17 | (** A queue of items of type ['a]. *) 18 | 19 | val create : int -> 'a t 20 | (** [create capacity] is a new stream which can hold up to [capacity] items without blocking writers. 21 | 22 | - If [capacity = 0] then writes block until a reader is ready. 23 | - If [capacity = 1] then this acts as a "mailbox". 24 | - If [capacity = max_int] then the stream is effectively unbounded. *) 25 | 26 | val add : 'a t -> 'a -> unit 27 | (** [add t item] adds [item] to [t]. 28 | 29 | If this would take [t] over capacity, it blocks until there is space. *) 30 | 31 | val take : 'a t -> 'a 32 | (** [take t] takes the next item from the head of [t]. 33 | 34 | If no items are available, it waits until one becomes available. *) 35 | 36 | val take_nonblocking : 'a t -> 'a option 37 | (** [take_nonblocking t] is like [Some (take t)] except that 38 | it returns [None] if the stream is empty rather than waiting. 39 | 40 | Note that if another domain may add to the stream then a [None] 41 | result may already be out-of-date by the time this returns. *) 42 | 43 | val length : 'a t -> int 44 | (** [length t] returns the number of items currently in [t]. *) 45 | 46 | val is_empty : 'a t -> bool 47 | (** [is_empty t] is [length t = 0]. *) 48 | -------------------------------------------------------------------------------- /lib_eio_linux/tests/eurcp_lib.ml: -------------------------------------------------------------------------------- 1 | (* cp(1) built with effects. *) 2 | 3 | open Eio.Std 4 | 5 | module U = Eio_linux.Low_level 6 | module Int63 = Optint.Int63 7 | 8 | let read_then_write_chunk infd outfd file_offset len = 9 | let buf = U.alloc_fixed_or_wait () in 10 | Logs.debug (fun l -> l "r/w start %a (%d)" Int63.pp file_offset len); 11 | U.read_exactly ~file_offset infd buf len; 12 | U.write ~file_offset outfd buf len; 13 | Logs.debug (fun l -> l "r/w done %a (%d)" Int63.pp file_offset len); 14 | U.free_fixed buf 15 | 16 | let copy_file infd outfd insize block_size = 17 | Switch.run @@ fun sw -> 18 | let rec copy_block file_offset = 19 | let remaining = Int63.(sub insize file_offset) in 20 | if remaining <> Int63.zero then ( 21 | let len = Int63.to_int (min (Int63.of_int block_size) remaining) in 22 | Fiber.fork ~sw (fun () -> read_then_write_chunk infd outfd file_offset len); 23 | copy_block Int63.(add file_offset (of_int len)) 24 | ) 25 | in 26 | copy_block Int63.zero 27 | 28 | let run_cp block_size queue_depth infile outfile () = 29 | Eio_linux.run ~queue_depth ~n_blocks:queue_depth ~block_size @@ fun _stdenv -> 30 | Switch.run @@ fun sw -> 31 | let open Unix in 32 | let infd = U.openfile ~sw infile [O_RDONLY] 0 in 33 | let outfd = U.openfile ~sw outfile [O_WRONLY; O_CREAT; O_TRUNC] 0o644 in 34 | let insize = U.fstat infd |> fun {st_size; _} -> Int63.of_int st_size in 35 | Logs.debug (fun l -> l "eurcp: %s -> %s size %a queue %d bs %d" 36 | infile 37 | outfile 38 | Int63.pp insize 39 | queue_depth 40 | block_size); 41 | copy_file infd outfd insize block_size; 42 | Logs.debug (fun l -> l "eurcp: done") 43 | -------------------------------------------------------------------------------- /lib_eio_luv/tests/files.md: -------------------------------------------------------------------------------- 1 | # Set up the test environment 2 | 3 | ```ocaml 4 | # #require "eio_luv";; 5 | # open Eio.Std;; 6 | ``` 7 | 8 | ```ocaml 9 | let rec read_exactly fd buf = 10 | let size = Luv.Buffer.size buf in 11 | if size > 0 then ( 12 | let got = Eio_luv.Low_level.File.read fd [buf] |> Eio_luv.Low_level.or_raise |> Unsigned.Size_t.to_int in 13 | let next = Luv.Buffer.sub buf ~offset:got ~length:(size - got) in 14 | read_exactly fd next 15 | ) 16 | 17 | let () = 18 | Luv.Error.set_on_unhandled_exception @@ fun ex -> 19 | Printf.printf "Unhandled luv exception: %s\n%!" (Printexc.to_string ex) 20 | ``` 21 | 22 | # Hello, world 23 | 24 | ```ocaml 25 | # Eio_luv.run @@ fun env -> 26 | Eio.Flow.copy_string "Hello, world!\n" (Eio.Stdenv.stdout env);; 27 | Hello, world! 28 | - : unit = () 29 | ``` 30 | 31 | # Read a few bytes from /dev/zero 32 | 33 | ```ocaml 34 | let main _stdenv = 35 | Switch.run @@ fun sw -> 36 | let fd = Eio_luv.Low_level.File.open_ ~sw "/dev/zero" [] |> Eio_luv.Low_level.or_raise in 37 | let buf = Luv.Buffer.create 4 in 38 | read_exactly fd buf; 39 | traceln "Read %S" (Luv.Buffer.to_string buf); 40 | Eio_luv.Low_level.File.close fd 41 | ``` 42 | 43 | ```ocaml 44 | # Eio_luv.run main;; 45 | +Read "\000\000\000\000" 46 | - : unit = () 47 | ``` 48 | 49 | # Test cancellation 50 | 51 | ```ocaml 52 | let main env = 53 | let name = "hang.pipe" in 54 | Unix.mkfifo name 0o700; 55 | Fun.protect ~finally:(fun () -> Unix.unlink name) @@ fun () -> 56 | Switch.run @@ fun sw -> 57 | let fd = Eio_luv.Low_level.File.open_ ~sw name [`NONBLOCK] |> Eio_luv.Low_level.or_raise in 58 | Fiber.both 59 | (fun () -> read_exactly fd (Luv.Buffer.create 1)) 60 | (fun () -> raise Exit);; 61 | ``` 62 | 63 | ```ocaml 64 | # Eio_luv.run main;; 65 | Exception: Stdlib.Exit. 66 | ``` 67 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.9) 2 | (name eio) 3 | (formatting disabled) 4 | (generate_opam_files true) 5 | (source (github ocaml-multicore/eio)) 6 | (license ISC) 7 | (authors "Anil Madhavapeddy" "Thomas Leonard") 8 | (maintainers "anil@recoil.org") 9 | (documentation "https://ocaml-multicore.github.io/eio/") 10 | (package 11 | (name eio) 12 | (synopsis "Effect-based direct-style IO API for OCaml") 13 | (description "An effect-based IO API for multicore OCaml with fibers.") 14 | (depends 15 | (ocaml (>= 5.0.0)) 16 | (bigstringaf (>= 0.9.0)) 17 | (cstruct (>= 6.0.1)) 18 | lwt-dllist 19 | (optint (>= 0.1.0)) 20 | (psq (>= 0.2.0)) 21 | (fmt (>= 0.8.9)) 22 | (hmap (>= 0.8.1)) 23 | (astring (and (>= 0.8.5) :with-test)) 24 | (crowbar (and (>= 0.2) :with-test)) 25 | (mtime (>= 1.2.0)) 26 | (alcotest (and (>= 1.4.0) :with-test)))) 27 | (package 28 | (name eio_linux) 29 | (synopsis "Eio implementation for Linux using io-uring") 30 | (description "An eio implementation for Linux using io-uring.") 31 | (depends 32 | (alcotest (and (>= 1.4.0) :with-test)) 33 | (eio (= :version)) 34 | (mdx (and (>= 1.10.0) :with-test)) 35 | (logs (>= 0.7.0)) 36 | (fmt (>= 0.8.9)) 37 | (cmdliner (and (>= 1.1.0) :with-test)) 38 | (uring (>= 0.4)))) 39 | (package 40 | (name eio_luv) 41 | (synopsis "Eio implementation using luv (libuv)") 42 | (description "An eio implementation for most platforms, using luv.") 43 | (depends 44 | (eio (= :version)) 45 | (luv (>= 0.5.11)) 46 | (luv_unix (>= 0.5.0)) 47 | (mdx (and (>= 1.10.0) :with-test)) 48 | (logs (>= 0.7.0)) 49 | (fmt (>= 0.8.9)))) 50 | (package 51 | (name eio_main) 52 | (synopsis "Effect-based direct-style IO mainloop for OCaml") 53 | (description "Selects an appropriate Eio backend for the current platform.") 54 | (depends 55 | (eio_linux (and (= :version) (= :os "linux"))) 56 | (mdx (and (>= 1.10.0) :with-test)) 57 | (eio_luv (= :version)))) 58 | (using mdx 0.1) 59 | -------------------------------------------------------------------------------- /bench/bench_semaphore.ml: -------------------------------------------------------------------------------- 1 | open Eio.Std 2 | 3 | let run_sender ~n_iters ~batch_size ~ack sem = 4 | for i = 1 to n_iters do 5 | Eio.Semaphore.release sem; 6 | if i mod batch_size = 0 then 7 | Eio.Semaphore.acquire ack 8 | done 9 | 10 | let run_bench ~domain_mgr ~clock ~use_domains ~n_iters ~batch_size = 11 | let sem = Eio.Semaphore.make 0 in 12 | let ack = Eio.Semaphore.make 0 in 13 | Gc.full_major (); 14 | let _minor0, prom0, _major0 = Gc.counters () in 15 | let t0 = Eio.Time.now clock in 16 | Fiber.both 17 | (fun () -> 18 | if use_domains then ( 19 | Eio.Domain_manager.run domain_mgr @@ fun () -> 20 | run_sender ~n_iters ~batch_size ~ack sem 21 | ) else ( 22 | run_sender ~n_iters ~batch_size ~ack sem 23 | ) 24 | ) 25 | (fun () -> 26 | for i = 1 to n_iters do 27 | Eio.Semaphore.acquire sem; 28 | if i mod batch_size = 0 then 29 | Eio.Semaphore.release ack 30 | done 31 | ); 32 | let t1 = Eio.Time.now clock in 33 | let time_total = t1 -. t0 in 34 | let time_per_iter = time_total /. float n_iters in 35 | let _minor1, prom1, _major1 = Gc.counters () in 36 | let prom = prom1 -. prom0 in 37 | Printf.printf "%11b, %8d, %3d, %8.2f, %13.4f\n%!" use_domains n_iters batch_size (1e9 *. time_per_iter) (prom /. float n_iters) 38 | 39 | let main ~domain_mgr ~clock = 40 | Printf.printf "use_domains, n_iters, batch, ns/iter, promoted/iter\n%!"; 41 | [false, 1_000_000, 1; 42 | false, 1_000_000, 10; 43 | false, 1_000_000, 100; 44 | true, 100_000, 1; 45 | true, 100_000, 10; 46 | true, 100_000, 100] 47 | |> List.iter (fun (use_domains, n_iters, batch_size) -> 48 | run_bench ~domain_mgr ~clock ~use_domains ~n_iters ~batch_size 49 | ) 50 | 51 | let () = 52 | Eio_main.run @@ fun env -> 53 | main 54 | ~domain_mgr:(Eio.Stdenv.domain_mgr env) 55 | ~clock:(Eio.Stdenv.clock env) 56 | -------------------------------------------------------------------------------- /bench/bench_cancel.ml: -------------------------------------------------------------------------------- 1 | open Eio.Std 2 | 3 | (* The main domain spawns two other domains, connected to each by a stream. 4 | It keeps reading from whichever stream is ready first, cancelling the other read. 5 | This tests the time needed to set up and tear down cancellation contexts and 6 | tests that cancellation can happen in parallel with success. *) 7 | 8 | let n_iters = 100_000 9 | 10 | let run_sender stream = 11 | for i = 1 to n_iters do 12 | Eio.Stream.add stream i 13 | done 14 | 15 | let run_bench ?domain_mgr ~clock () = 16 | let stream1 = Eio.Stream.create 1 in 17 | let stream2 = Eio.Stream.create 1 in 18 | let run_sender stream () = 19 | match domain_mgr with 20 | | Some dm -> Eio.Domain_manager.run dm (fun () -> run_sender stream) 21 | | None -> run_sender stream 22 | in 23 | Gc.full_major (); 24 | let _minor0, prom0, _major0 = Gc.counters () in 25 | let t0 = Eio.Time.now clock in 26 | try 27 | Switch.run (fun sw -> 28 | Fiber.fork ~sw (run_sender stream1); 29 | Fiber.fork ~sw (run_sender stream2); 30 | for _ = 1 to n_iters do 31 | ignore @@ 32 | Fiber.first 33 | (fun () -> Eio.Stream.take stream1) 34 | (fun () -> Eio.Stream.take stream2) 35 | done; 36 | raise Exit 37 | ) 38 | with Exit -> 39 | let t1 = Eio.Time.now clock in 40 | let time_total = t1 -. t0 in 41 | let time_per_iter = time_total /. float n_iters in 42 | let _minor1, prom1, _major1 = Gc.counters () in 43 | let prom = prom1 -. prom0 in 44 | Printf.printf "%11b, %7.2f, %13.4f\n%!" (domain_mgr <> None) (1e9 *. time_per_iter) (prom /. float n_iters) 45 | 46 | let main ~domain_mgr ~clock = 47 | Printf.printf "use_domains, ns/iter, promoted/iter\n%!"; 48 | run_bench ~clock (); 49 | run_bench ~domain_mgr ~clock () 50 | 51 | let () = 52 | Eio_main.run @@ fun env -> 53 | main 54 | ~domain_mgr:(Eio.Stdenv.domain_mgr env) 55 | ~clock:(Eio.Stdenv.clock env) 56 | -------------------------------------------------------------------------------- /bench/bench_mutex.ml: -------------------------------------------------------------------------------- 1 | open Eio.Std 2 | 3 | let v = ref 0 4 | 5 | let run_sender ~iters_per_thread mutex = 6 | for _ = 1 to iters_per_thread do 7 | Eio.Mutex.lock mutex; 8 | let x = !v in 9 | v := x + 1; 10 | Fiber.yield (); 11 | assert (!v = x + 1); 12 | v := x; 13 | Eio.Mutex.unlock mutex; 14 | done 15 | 16 | let run_bench ~domain_mgr ~clock ~use_domains ~iters_per_thread ~threads = 17 | let mutex = Eio.Mutex.create () in 18 | Gc.full_major (); 19 | let _minor0, prom0, _major0 = Gc.counters () in 20 | let t0 = Eio.Time.now clock in 21 | Switch.run (fun sw -> 22 | for _ = 1 to threads do 23 | Fiber.fork ~sw (fun () -> 24 | if use_domains then ( 25 | Eio.Domain_manager.run domain_mgr @@ fun () -> 26 | run_sender ~iters_per_thread mutex 27 | ) else ( 28 | run_sender ~iters_per_thread mutex 29 | ) 30 | ) 31 | done 32 | ); 33 | assert (!v = 0); 34 | let t1 = Eio.Time.now clock in 35 | let time_total = t1 -. t0 in 36 | let n_iters = iters_per_thread * threads in 37 | let time_per_iter = time_total /. float n_iters in 38 | let _minor1, prom1, _major1 = Gc.counters () in 39 | let prom = prom1 -. prom0 in 40 | Printf.printf "%11b, %12d, %8d, %8.2f, %13.4f\n%!" use_domains n_iters threads (1e9 *. time_per_iter) (prom /. float n_iters) 41 | 42 | let main ~domain_mgr ~clock = 43 | Printf.printf "use_domains, iters/thread, threads, ns/iter, promoted/iter\n%!"; 44 | [false, 1_000_000, 1; 45 | false, 1_000_000, 2; 46 | false, 100_000, 8; 47 | true, 100_000, 1; 48 | true, 10_000, 2; 49 | true, 10_000, 8] 50 | |> List.iter (fun (use_domains, iters_per_thread, threads) -> 51 | run_bench ~domain_mgr ~clock ~use_domains ~iters_per_thread ~threads 52 | ) 53 | 54 | let () = 55 | Eio_main.run @@ fun env -> 56 | main 57 | ~domain_mgr:(Eio.Stdenv.domain_mgr env) 58 | ~clock:(Eio.Stdenv.clock env) 59 | -------------------------------------------------------------------------------- /fuzz/fuzz_buf_write.ml: -------------------------------------------------------------------------------- 1 | (* Run a random sequence of write operations on an [Eio.Buf_write]. 2 | Check that the expected data gets written to the flow. *) 3 | 4 | module W = Eio.Buf_write 5 | 6 | let initial_size = 10 7 | 8 | type op = Op : string * (W.t -> unit) -> op (* Expected string, writer *) 9 | 10 | let cstruct = 11 | Crowbar.(map [bytes; int; int]) (fun s off len -> 12 | if String.length s = 0 then Cstruct.empty 13 | else ( 14 | let off = min (abs off) (String.length s) in 15 | let len = min (abs len) (String.length s - off) in 16 | Cstruct.of_string s ~off ~len 17 | ) 18 | ) 19 | 20 | let op = 21 | let label (name, gen) = Crowbar.with_printer (fun f (Op (s, _)) -> Fmt.pf f "%s:%S" name s) gen in 22 | Crowbar.choose @@ List.map label [ 23 | "string", Crowbar.(map [bytes]) (fun s -> Op (s, (fun t -> W.string t s))); 24 | "cstruct", Crowbar.(map [cstruct]) (fun cs -> Op (Cstruct.to_string cs, (fun t -> W.cstruct t cs))); 25 | "schedule_cstruct", Crowbar.(map [cstruct]) (fun cs -> Op (Cstruct.to_string cs, (fun t -> W.schedule_cstruct t cs))); 26 | "yield", Crowbar.const @@ Op ("", (fun _ -> Eio.Fiber.yield ())); 27 | "flush", Crowbar.const @@ Op ("", W.flush); 28 | "pause", Crowbar.const @@ Op ("", W.pause); 29 | "unpause", Crowbar.const @@ Op ("", W.unpause); 30 | ] 31 | 32 | let random ops close = 33 | Eio_mock.Backend.run @@ fun _ -> 34 | let b = Buffer.create 100 in 35 | let flow = Eio.Flow.buffer_sink b in 36 | let expected = ref [] in 37 | W.with_flow flow ~initial_size (fun t -> 38 | let perform (Op (s, write)) = 39 | expected := s :: !expected; 40 | write t 41 | in 42 | List.iter perform ops; 43 | if close then W.close t 44 | ); 45 | let expected = String.concat "" (List.rev !expected) in 46 | Crowbar.check_eq ~pp:Fmt.Dump.string (Buffer.contents b) expected 47 | 48 | let () = 49 | Crowbar.(add_test ~name:"random ops" [list op; bool] random) 50 | -------------------------------------------------------------------------------- /lib_eio/fs.ml: -------------------------------------------------------------------------------- 1 | (** Defines types used by file-systems. *) 2 | 3 | (** Tranditional Unix permissions. *) 4 | module Unix_perm = struct 5 | type t = int 6 | (** This is the same as {!Unix.file_perm}, but avoids a dependency on [Unix]. *) 7 | end 8 | 9 | type path = string 10 | 11 | exception Already_exists of path * exn 12 | exception Not_found of path * exn 13 | exception Permission_denied of path * exn 14 | 15 | class virtual rw = object (_ : ) 16 | method probe _ = None 17 | method read_methods = [] 18 | end 19 | 20 | (** When to create a new file. *) 21 | type create = [ 22 | | `Never (** fail if the named file doesn't exist *) 23 | | `If_missing of Unix_perm.t (** create if file doesn't already exist *) 24 | | `Or_truncate of Unix_perm.t (** any existing file is truncated to zero length *) 25 | | `Exclusive of Unix_perm.t (** always create; fail if the file already exists *) 26 | ] 27 | (** If a new file is created, the given permissions are used for it. *) 28 | 29 | (** Note: use the functions in {!Path} to access directories. *) 30 | class virtual dir = object (_ : #Generic.t) 31 | method probe _ = None 32 | method virtual open_in : sw:Switch.t -> path -> 33 | method virtual open_out : 34 | sw:Switch.t -> 35 | append:bool -> 36 | create:create -> 37 | path -> 38 | method virtual mkdir : perm:Unix_perm.t -> path -> unit 39 | method virtual open_dir : sw:Switch.t -> path -> dir_with_close 40 | method virtual read_dir : path -> string list 41 | method virtual unlink : path -> unit 42 | method virtual rmdir : path -> unit 43 | method virtual rename : path -> dir -> path -> unit 44 | method virtual pp : Format.formatter -> unit 45 | end 46 | and virtual dir_with_close = object 47 | (* This dummy class avoids an "Error: The type < .. > is not an object type" error from the compiler. *) 48 | inherit dir 49 | method virtual close : unit 50 | end 51 | -------------------------------------------------------------------------------- /lib_eio/core/waiters.ml: -------------------------------------------------------------------------------- 1 | type 'a waiter = { 2 | enqueue : ('a, exn) result -> unit; 3 | ctx : Cancel.Fiber_context.t; 4 | } 5 | 6 | type 'a t = 'a waiter Lwt_dllist.t 7 | 8 | let create = Lwt_dllist.create 9 | 10 | let add_waiter_protected ~mutex t cb = 11 | let w = Lwt_dllist.add_l cb t in 12 | Hook.Node_with_mutex (w, mutex) 13 | 14 | let add_waiter t cb = 15 | let w = Lwt_dllist.add_l cb t in 16 | Hook.Node w 17 | 18 | (* Wake a waiter with the result. 19 | Returns [false] if the waiter got cancelled while we were trying to wake it. *) 20 | let wake { enqueue; ctx } r = 21 | if Cancel.Fiber_context.clear_cancel_fn ctx then (enqueue (Ok r); true) 22 | else false (* [cancel] gets called and we enqueue an error *) 23 | 24 | let wake_all (t:_ t) v = 25 | try 26 | while true do 27 | let waiter = Lwt_dllist.take_r t in 28 | ignore (wake waiter v : bool) 29 | done 30 | with Lwt_dllist.Empty -> () 31 | 32 | let rec wake_one t v = 33 | match Lwt_dllist.take_opt_r t with 34 | | None -> `Queue_empty 35 | | Some waiter -> 36 | if wake waiter v then `Ok 37 | else wake_one t v 38 | 39 | let is_empty = Lwt_dllist.is_empty 40 | 41 | let await_internal ~mutex (t:'a t) id (ctx:Cancel.fiber_context) enqueue = 42 | match Cancel.Fiber_context.get_error ctx with 43 | | Some ex -> 44 | Option.iter Mutex.unlock mutex; 45 | enqueue (Error ex) 46 | | None -> 47 | let resolved_waiter = ref Hook.null in 48 | let enqueue x = 49 | Ctf.note_read ~reader:id ctx.tid; 50 | enqueue x 51 | in 52 | let cancel ex = 53 | Hook.remove !resolved_waiter; 54 | enqueue (Error ex) 55 | in 56 | Cancel.Fiber_context.set_cancel_fn ctx cancel; 57 | let waiter = { enqueue; ctx } in 58 | match mutex with 59 | | None -> 60 | resolved_waiter := add_waiter t waiter 61 | | Some mutex -> 62 | resolved_waiter := add_waiter_protected ~mutex t waiter; 63 | Mutex.unlock mutex 64 | 65 | (* Returns a result if the wait succeeds, or raises if cancelled. *) 66 | let await ~mutex waiters id = 67 | Suspend.enter_unchecked (await_internal ~mutex waiters id) 68 | -------------------------------------------------------------------------------- /tests/lf_queue.md: -------------------------------------------------------------------------------- 1 | # A lock-free queue for schedulers 2 | 3 | ```ocaml 4 | # #require "eio.utils";; 5 | ``` 6 | 7 | ```ocaml 8 | module Q = Eio_utils.Lf_queue;; 9 | ``` 10 | 11 | ## A basic run 12 | 13 | ```ocaml 14 | # let q : int Q.t = Q.create ();; 15 | val q : int Q.t = 16 | # Q.push q 1;; 17 | - : unit = () 18 | # Q.push q 2;; 19 | - : unit = () 20 | # Q.pop q;; 21 | - : int option = Some 1 22 | # Q.pop q;; 23 | - : int option = Some 2 24 | # Q.pop q;; 25 | - : int option = None 26 | # Q.pop q;; 27 | - : int option = None 28 | # Q.push q 3;; 29 | - : unit = () 30 | # Q.pop q;; 31 | - : int option = Some 3 32 | ``` 33 | 34 | ## Closing the queue 35 | 36 | ```ocaml 37 | # let q : int Q.t = Q.create ();; 38 | val q : int Q.t = 39 | # Q.push q 1;; 40 | - : unit = () 41 | # Q.close q;; 42 | - : unit = () 43 | # Q.push q 2;; 44 | Exception: Eio_utils__Lf_queue.Closed. 45 | # Q.push_head q 3;; 46 | - : unit = () 47 | # Q.pop q;; 48 | - : int option = Some 3 49 | # Q.pop q;; 50 | - : int option = Some 1 51 | # Q.pop q;; 52 | Exception: Eio_utils__Lf_queue.Closed. 53 | # Q.push_head q 4;; 54 | Exception: Eio_utils__Lf_queue.Closed. 55 | ``` 56 | 57 | ## Closing an empty queue 58 | 59 | ```ocaml 60 | # let q = Q.create () in Q.close q; Q.push q 1;; 61 | Exception: Eio_utils__Lf_queue.Closed. 62 | ``` 63 | 64 | ## Empty? 65 | 66 | ```ocaml 67 | # let q : int Q.t = Q.create ();; 68 | val q : int Q.t = 69 | # Q.is_empty q;; 70 | - : bool = true 71 | # Q.push q 1; Q.is_empty q;; 72 | - : bool = false 73 | # Q.pop q;; 74 | - : int option = Some 1 75 | # Q.is_empty q;; 76 | - : bool = true 77 | # Q.close q; Q.is_empty q;; 78 | Exception: Eio_utils__Lf_queue.Closed. 79 | ``` 80 | 81 | ## Pushing to the head 82 | 83 | ```ocaml 84 | # let q : int Q.t = Q.create ();; 85 | val q : int Q.t = 86 | # Q.push_head q 3; Q.push q 4; Q.push_head q 2; Q.push q 5; Q.push_head q 1;; 87 | - : unit = () 88 | # Q.pop q;; 89 | - : int option = Some 1 90 | # Q.pop q;; 91 | - : int option = Some 2 92 | # Q.pop q;; 93 | - : int option = Some 3 94 | # Q.pop q;; 95 | - : int option = Some 4 96 | # Q.pop q;; 97 | - : int option = Some 5 98 | # Q.pop q;; 99 | - : int option = None 100 | ``` 101 | -------------------------------------------------------------------------------- /tests/flow.md: -------------------------------------------------------------------------------- 1 | ## Setting up the environment 2 | 3 | ```ocaml 4 | # #require "eio_main";; 5 | # #require "eio.mock";; 6 | ``` 7 | 8 | ```ocaml 9 | open Eio.Std 10 | 11 | let run fn = 12 | Eio_main.run @@ fun _ -> 13 | fn () 14 | 15 | let mock_source items = 16 | object 17 | inherit Eio.Flow.source 18 | 19 | val mutable items = items 20 | 21 | method read_methods = [] 22 | 23 | method read_into buf = 24 | match items with 25 | | [] -> raise End_of_file 26 | | x :: xs -> 27 | let len = min (Cstruct.length buf) (Cstruct.length x) in 28 | Cstruct.blit x 0 buf 0 len; 29 | items <- Cstruct.shiftv (x :: xs) len; 30 | len 31 | end 32 | ``` 33 | 34 | ## read_exact 35 | 36 | ```ocaml 37 | # run @@ fun () -> 38 | let data = List.map Cstruct.of_string ["foo"; "bar"] in 39 | let test n = 40 | let buf = Cstruct.create n in 41 | Eio.Flow.read_exact (mock_source data) buf; 42 | traceln "Got %S" (Cstruct.to_string buf) 43 | in 44 | test 0; 45 | test 3; 46 | test 5; 47 | test 6; 48 | test 7;; 49 | +Got "" 50 | +Got "foo" 51 | +Got "fooba" 52 | +Got "foobar" 53 | Exception: End_of_file. 54 | ``` 55 | 56 | ## copy 57 | 58 | ```ocaml 59 | # run @@ fun () -> 60 | let src = Eio_mock.Flow.make "src" in 61 | let dst = Eio_mock.Flow.make "dst" in 62 | Eio_mock.Flow.on_read src [`Return "foo"; `Return "bar"]; 63 | Eio.Flow.copy src dst;; 64 | +src: read "foo" 65 | +dst: wrote "foo" 66 | +src: read "bar" 67 | +dst: wrote "bar" 68 | - : unit = () 69 | ``` 70 | 71 | Copying from src using a plain buffer (the default): 72 | 73 | ```ocaml 74 | # run @@ fun () -> 75 | let src = Eio.Flow.string_source "foobar" in 76 | let dst = Eio_mock.Flow.make "dst" in 77 | Eio_mock.Flow.on_copy_bytes dst [`Return 3; `Return 5]; 78 | Eio.Flow.copy src dst;; 79 | +dst: wrote "foo" 80 | +dst: wrote "bar" 81 | - : unit = () 82 | ``` 83 | Copying from src using `Read_source_buffer`: 84 | 85 | ```ocaml 86 | # run @@ fun () -> 87 | let src = Eio.Flow.string_source "foobar" in 88 | let dst = Eio_mock.Flow.make "dst" in 89 | Eio_mock.Flow.set_copy_method dst `Read_source_buffer; 90 | Eio_mock.Flow.on_copy_bytes dst [`Return 3; `Return 5]; 91 | Eio.Flow.copy src dst;; 92 | +dst: wrote (rsb) ["foo"] 93 | +dst: wrote (rsb) ["bar"] 94 | - : unit = () 95 | ``` 96 | -------------------------------------------------------------------------------- /lib_eio/condition.mli: -------------------------------------------------------------------------------- 1 | (** Waiters call {!await} in a loop as long as some condition is false. 2 | Fibers that modify inputs to the condition must call [broadcast] soon 3 | afterwards so that waiters can re-check the condition. 4 | 5 | Example: 6 | 7 | {[ 8 | let x = ref 0 9 | let cond = Eio.Condition.create () 10 | let mutex = Eio.Mutex.create () 11 | 12 | let set_x value = 13 | Eio.Mutex.use_rw ~protect:false mutex (fun () -> x := value); 14 | Eio.Condition.broadcast cond 15 | 16 | let await_x p = 17 | Eio.Mutex.use_ro mutex (fun () -> 18 | while not (p !x) do (* [x] cannot change, as mutex is locked. *) 19 | Eio.Condition.await ~mutex cond (* Mutex is unlocked while suspended. *) 20 | done 21 | ) 22 | ]} 23 | 24 | It is used like this: 25 | 26 | {[ 27 | Fiber.both 28 | (fun () -> 29 | traceln "x = %d" !x; 30 | await_x ((=) 42); 31 | traceln "x = %d" !x 32 | ) 33 | (fun () -> 34 | set_x 5; 35 | Fiber.yield (); 36 | set_x 7; 37 | set_x 42; 38 | ) 39 | ]} 40 | *) 41 | 42 | type t 43 | 44 | val create : unit -> t 45 | (** [create ()] creates a new condition variable. *) 46 | 47 | val await : t -> Eio_mutex.t -> unit 48 | (** [await t mutex] suspends the current fiber until it is notified by [t]. 49 | 50 | You should lock [mutex] before testing whether the condition is true, 51 | and leave it locked while calling this function. 52 | It will be unlocked while the fiber is waiting and locked again before 53 | returning (it is also locked again if the wait is cancelled). *) 54 | 55 | val await_no_mutex : t -> unit 56 | (** [await_no_mutex t] suspends the current fiber until it is notified by [t]. 57 | 58 | This is only safe to use in the case where [t] is only used within a single domain, 59 | and the test for the condition was done without switching fibers. 60 | i.e. you know the condition is still false, and no notification of a change can be sent 61 | until [await_no_mutex] has finished suspending the fiber. *) 62 | 63 | val broadcast : t -> unit 64 | (** [broadcast t] wakes up any waiting fibers (by appending them to the run-queue to resume later). 65 | 66 | If no fibers are waiting, nothing happens. *) 67 | -------------------------------------------------------------------------------- /lib_eio/flow.ml: -------------------------------------------------------------------------------- 1 | type shutdown_command = [ `Receive | `Send | `All ] 2 | 3 | type read_method = .. 4 | type read_method += Read_source_buffer of ((Cstruct.t list -> int) -> unit) 5 | 6 | class type close = object 7 | method close : unit 8 | end 9 | 10 | let close (t : #close) = t#close 11 | 12 | class virtual source = object (_ : ) 13 | method probe _ = None 14 | method read_methods : read_method list = [] 15 | method virtual read_into : Cstruct.t -> int 16 | end 17 | 18 | let read (t : #source) buf = 19 | let got = t#read_into buf in 20 | assert (got > 0 && got <= Cstruct.length buf); 21 | got 22 | 23 | let read_methods (t : #source) = t#read_methods 24 | 25 | let rec read_exact t buf = 26 | if Cstruct.length buf > 0 then ( 27 | let got = read t buf in 28 | read_exact t (Cstruct.shift buf got) 29 | ) 30 | 31 | let cstruct_source data : source = 32 | object (self) 33 | val mutable data = data 34 | 35 | inherit source 36 | 37 | method private read_source_buffer fn = 38 | let rec aux () = 39 | match data with 40 | | [] -> raise End_of_file 41 | | x :: xs when Cstruct.length x = 0 -> data <- xs; aux () 42 | | xs -> 43 | let n = fn xs in 44 | data <- Cstruct.shiftv xs n 45 | in 46 | aux () 47 | 48 | method! read_methods = 49 | [ Read_source_buffer self#read_source_buffer ] 50 | 51 | method read_into dst = 52 | let avail, src = Cstruct.fillv ~dst ~src:data in 53 | if avail = 0 then raise End_of_file; 54 | data <- src; 55 | avail 56 | end 57 | 58 | let string_source s = cstruct_source [Cstruct.of_string s] 59 | 60 | class virtual sink = object (_ : ) 61 | method probe _ = None 62 | method virtual copy : 'a. (#source as 'a) -> unit 63 | end 64 | 65 | let copy (src : #source) (dst : #sink) = dst#copy src 66 | 67 | let copy_string s = copy (string_source s) 68 | 69 | let buffer_sink b = 70 | object 71 | inherit sink 72 | 73 | method copy src = 74 | let buf = Cstruct.create 4096 in 75 | try 76 | while true do 77 | let got = src#read_into buf in 78 | Buffer.add_string b (Cstruct.to_string ~len:got buf) 79 | done 80 | with End_of_file -> () 81 | end 82 | 83 | class virtual two_way = object (_ : ) 84 | method probe _ = None 85 | method read_methods = [] 86 | 87 | method virtual shutdown : shutdown_command -> unit 88 | end 89 | 90 | let shutdown (t : #two_way) = t#shutdown 91 | -------------------------------------------------------------------------------- /lib_eio/unix/eio_unix.ml: -------------------------------------------------------------------------------- 1 | type unix_fd = < 2 | unix_fd : [`Peek | `Take] -> Unix.file_descr; 3 | > 4 | 5 | type socket = < 6 | Eio.Flow.two_way; 7 | Eio.Flow.close; 8 | unix_fd; 9 | > 10 | 11 | module Private = struct 12 | type _ Eio.Generic.ty += Unix_file_descr : [`Peek | `Take] -> Unix.file_descr Eio.Generic.ty 13 | 14 | type _ Effect.t += 15 | | Await_readable : Unix.file_descr -> unit Effect.t 16 | | Await_writable : Unix.file_descr -> unit Effect.t 17 | | Get_system_clock : Eio.Time.clock Effect.t 18 | | Socket_of_fd : Eio.Switch.t * bool * Unix.file_descr -> socket Effect.t 19 | | Socketpair : Eio.Switch.t * Unix.socket_domain * Unix.socket_type * int -> (socket * socket) Effect.t 20 | end 21 | 22 | let await_readable fd = Effect.perform (Private.Await_readable fd) 23 | let await_writable fd = Effect.perform (Private.Await_writable fd) 24 | 25 | let sleep d = 26 | Eio.Time.sleep (Effect.perform Private.Get_system_clock) d 27 | 28 | let run_in_systhread fn = 29 | let f fiber enqueue = 30 | match Eio.Private.Fiber_context.get_error fiber with 31 | | Some err -> enqueue (Error err) 32 | | None -> 33 | let _t : Thread.t = Thread.create (fun () -> enqueue (try Ok (fn ()) with exn -> Error exn)) () in 34 | () 35 | in 36 | Effect.perform (Eio.Private.Effects.Suspend f) 37 | 38 | module FD = struct 39 | let peek x = x#unix_fd `Peek 40 | let take x = x#unix_fd `Take 41 | 42 | let peek_opt x = Eio.Generic.probe x (Private.Unix_file_descr `Peek) 43 | let take_opt x = Eio.Generic.probe x (Private.Unix_file_descr `Take) 44 | 45 | let as_socket ~sw ~close_unix fd = Effect.perform (Private.Socket_of_fd (sw, close_unix, fd)) 46 | end 47 | 48 | let socketpair ~sw ?(domain=Unix.PF_UNIX) ?(ty=Unix.SOCK_STREAM) ?(protocol=0) () = 49 | Effect.perform (Private.Socketpair (sw, domain, ty, protocol)) 50 | 51 | module Ipaddr = struct 52 | let to_unix : _ Eio.Net.Ipaddr.t -> Unix.inet_addr = Obj.magic 53 | let of_unix : Unix.inet_addr -> _ Eio.Net.Ipaddr.t = Obj.magic 54 | end 55 | 56 | module Ctf = Ctf_unix 57 | 58 | let getnameinfo (sockaddr : Eio.Net.Sockaddr.t) = 59 | let sockaddr, options = 60 | match sockaddr with 61 | | `Unix s -> (Unix.ADDR_UNIX s, []) 62 | | `Tcp (addr, port) -> (Unix.ADDR_INET (Ipaddr.to_unix addr, port), []) 63 | | `Udp (addr, port) -> (Unix.ADDR_INET (Ipaddr.to_unix addr, port), [Unix.NI_DGRAM]) 64 | in 65 | run_in_systhread (fun () -> 66 | let Unix.{ni_hostname; ni_service} = Unix.getnameinfo sockaddr options in 67 | (ni_hostname, ni_service)) 68 | -------------------------------------------------------------------------------- /tests/time.md: -------------------------------------------------------------------------------- 1 | # Setting up the environment 2 | 3 | ```ocaml 4 | # #require "eio_main";; 5 | ``` 6 | 7 | ```ocaml 8 | open Eio.Std 9 | 10 | let run (fn : clock:Eio.Time.clock -> unit) = 11 | Eio_main.run @@ fun env -> 12 | let clock = Eio.Stdenv.clock env in 13 | fn ~clock 14 | ``` 15 | 16 | # Test cases 17 | 18 | Check sleep works: 19 | 20 | ```ocaml 21 | # run @@ fun ~clock -> 22 | let t0 = Unix.gettimeofday () in 23 | Eio.Time.sleep clock 0.01; 24 | let t1 = Unix.gettimeofday () in 25 | assert (t1 -. t0 >= 0.01);; 26 | - : unit = () 27 | ``` 28 | 29 | Cancelling sleep: 30 | 31 | ```ocaml 32 | # run @@ fun ~clock -> 33 | Fiber.both 34 | (fun () -> Eio.Time.sleep clock 1200.; assert false) 35 | (fun () -> failwith "Simulated cancel");; 36 | Exception: Failure "Simulated cancel". 37 | ``` 38 | 39 | Switch is already off: 40 | 41 | ```ocaml 42 | # run @@ fun ~clock -> 43 | Switch.run @@ fun sw -> 44 | Switch.fail sw (Failure "Simulated failure"); 45 | Eio.Time.sleep clock 1200.0; 46 | assert false;; 47 | Exception: Failure "Simulated failure". 48 | ``` 49 | 50 | Scheduling a timer that's already due: 51 | 52 | ```ocaml 53 | # run @@ fun ~clock -> 54 | Switch.run @@ fun sw -> 55 | Fiber.both 56 | (fun () -> traceln "First fiber runs"; Eio.Time.sleep clock (-1.0); traceln "Sleep done") 57 | (fun () -> traceln "Second fiber runs");; 58 | +First fiber runs 59 | +Second fiber runs 60 | +Sleep done 61 | - : unit = () 62 | ``` 63 | 64 | Check ordering works: 65 | 66 | ```ocaml 67 | # run @@ fun ~clock -> 68 | Switch.run @@ fun sw -> 69 | Fiber.both 70 | (fun () -> 71 | Eio.Time.sleep clock 1200.0; 72 | assert false 73 | ) 74 | (fun () -> 75 | Eio.Time.sleep clock 0.1; 76 | traceln "Short timer finished"; 77 | failwith "Simulated cancel" 78 | );; 79 | +Short timer finished 80 | Exception: Failure "Simulated cancel". 81 | ``` 82 | 83 | Check Unix debug clock: 84 | ```ocaml 85 | # Eio_main.run @@ fun _ -> 86 | Fiber.both 87 | (fun () -> traceln "First thread starts"; Eio_unix.sleep 0.001; traceln "Sleep done") 88 | (fun () -> traceln "Second thread starts");; 89 | +First thread starts 90 | +Second thread starts 91 | +Sleep done 92 | - : unit = () 93 | ``` 94 | 95 | Timer and busy loop: 96 | ```ocaml 97 | let rec loop () = 98 | Eio.Fiber.yield (); 99 | loop () 100 | ``` 101 | 102 | ```ocaml 103 | # run @@ fun ~clock -> 104 | Fiber.yield (); 105 | Eio.Time.sleep clock 0.01; 106 | Fiber.first 107 | loop 108 | (fun () -> Eio.Time.sleep clock 0.01);; 109 | - : unit = () 110 | ``` 111 | -------------------------------------------------------------------------------- /lib_eio/mock/backend.ml: -------------------------------------------------------------------------------- 1 | module Fiber_context = Eio.Private.Fiber_context 2 | module Lf_queue = Eio_utils.Lf_queue 3 | 4 | exception Deadlock_detected 5 | 6 | (* The scheduler could just return [unit], but this is clearer. *) 7 | type exit = Exit_scheduler 8 | 9 | type t = { 10 | (* Suspended fibers waiting to run again. 11 | [Lf_queue] is like [Stdlib.Queue], but is thread-safe (lock-free) and 12 | allows pushing items to the head too, which we need. *) 13 | mutable run_q : (unit -> exit) Lf_queue.t; 14 | } 15 | 16 | (* Resume the next runnable fiber, if any. *) 17 | let schedule t : exit = 18 | match Lf_queue.pop t.run_q with 19 | | Some f -> f () 20 | | None -> Exit_scheduler (* Finished (or deadlocked) *) 21 | 22 | (* Run [main] in an Eio main loop. *) 23 | let run main = 24 | let t = { run_q = Lf_queue.create () } in 25 | let rec fork ~new_fiber:fiber fn = 26 | (* Create a new fiber and run [fn] in it. *) 27 | Effect.Deep.match_with fn () 28 | { retc = (fun () -> Fiber_context.destroy fiber; schedule t); 29 | exnc = (fun ex -> Fiber_context.destroy fiber; raise ex); 30 | effc = fun (type a) (e : a Effect.t) : ((a, exit) Effect.Deep.continuation -> exit) option -> 31 | match e with 32 | | Eio.Private.Effects.Suspend f -> Some (fun k -> 33 | (* Ask [f] to register whatever callbacks are needed to resume the fiber. 34 | e.g. it might register a callback with a promise, for when that's resolved. *) 35 | f fiber (function 36 | (* The fiber is ready to run again. Add it to the queue. *) 37 | | Ok v -> Lf_queue.push t.run_q (fun () -> Effect.Deep.continue k v) 38 | | Error ex -> Lf_queue.push t.run_q (fun () -> Effect.Deep.discontinue k ex) 39 | ); 40 | (* Switch to the next runnable fiber while this one's blocked. *) 41 | schedule t 42 | ) 43 | | Eio.Private.Effects.Fork (new_fiber, f) -> Some (fun k -> 44 | (* Arrange for the forking fiber to run immediately after the new one. *) 45 | Lf_queue.push_head t.run_q (Effect.Deep.continue k); 46 | (* Create and run the new fiber (using fiber context [new_fiber]). *) 47 | fork ~new_fiber f 48 | ) 49 | | Eio.Private.Effects.Get_context -> Some (fun k -> 50 | Effect.Deep.continue k fiber 51 | ) 52 | | _ -> None 53 | } 54 | in 55 | let new_fiber = Fiber_context.make_root () in 56 | let result = ref None in 57 | let Exit_scheduler = fork ~new_fiber (fun () -> result := Some (main ())) in 58 | match !result with 59 | | None -> raise Deadlock_detected 60 | | Some x -> x 61 | -------------------------------------------------------------------------------- /tests/mocks.md: -------------------------------------------------------------------------------- 1 | ## Setup 2 | 3 | ```ocaml 4 | # #require "eio.mock";; 5 | ``` 6 | 7 | ```ocaml 8 | open Eio.Std 9 | let stdin = Eio_mock.Flow.make "stdin" 10 | let stdout = Eio_mock.Flow.make "stdout" 11 | ``` 12 | 13 | ## Flows 14 | 15 | ```ocaml 16 | # Eio_mock.Backend.run @@ fun _ -> 17 | Eio_mock.Flow.on_read stdin [ 18 | `Return "chunk1"; 19 | `Return "chunk2"; 20 | `Raise End_of_file 21 | ]; 22 | Eio.Flow.copy stdin stdout; 23 | Eio.Flow.close stdin; 24 | Eio.Flow.shutdown stdout `Send;; 25 | +stdin: read "chunk1" 26 | +stdout: wrote "chunk1" 27 | +stdin: read "chunk2" 28 | +stdout: wrote "chunk2" 29 | +stdin: closed 30 | +stdout: shutdown send 31 | - : unit = () 32 | ``` 33 | 34 | ## Networks 35 | 36 | A simple test server: 37 | 38 | ```ocaml 39 | let echo_server ~net addr = 40 | Switch.run @@ fun sw -> 41 | let socket = Eio.Net.listen net ~sw ~reuse_addr:true ~backlog:5 addr in 42 | Eio.Net.accept_fork socket ~sw (fun flow _addr -> Eio.Flow.copy flow flow) 43 | ~on_error:(traceln "Error handling connection: %a" Fmt.exn);; 44 | ``` 45 | 46 | The server handles a connection: 47 | 48 | ```ocaml 49 | # Eio_mock.Backend.run @@ fun _ -> 50 | let net = Eio_mock.Net.make "mocknet" in 51 | let listening_socket = Eio_mock.Net.listening_socket "tcp/80" in 52 | Eio_mock.Net.on_listen net [`Return listening_socket]; 53 | let connection = Eio_mock.Flow.make "connection" in 54 | let addr = `Tcp (Eio.Net.Ipaddr.V4.loopback, 37568) in 55 | Eio_mock.Net.on_accept listening_socket [`Return (connection, addr)]; 56 | Eio_mock.Flow.on_read connection [`Return "foo"; `Return "bar"]; 57 | echo_server ~net (`Tcp (Eio.Net.Ipaddr.V4.loopback, 80));; 58 | +mocknet: listen on tcp:127.0.0.1:80 59 | +tcp/80: accepted connection from tcp:127.0.0.1:37568 60 | +connection: read "foo" 61 | +connection: wrote "foo" 62 | +connection: read "bar" 63 | +connection: wrote "bar" 64 | +connection: closed 65 | +tcp/80: closed 66 | - : unit = () 67 | ``` 68 | 69 | ## Backend 70 | 71 | `Eio_mock.Backend` supports forking, tracing, suspending and cancellation: 72 | 73 | ```ocaml 74 | # Eio_mock.Backend.run @@ fun () -> 75 | let s = Eio.Stream.create 1 in 76 | try 77 | Fiber.both 78 | (fun () -> 79 | for x = 1 to 3 do 80 | traceln "Sending %d" x; 81 | Eio.Stream.add s x 82 | done; 83 | raise Exit 84 | ) 85 | (fun () -> 86 | while true do 87 | traceln "Got %d" (Eio.Stream.take s) 88 | done 89 | ) 90 | with Exit -> 91 | traceln "Finished!";; 92 | +Sending 1 93 | +Sending 2 94 | +Got 1 95 | +Got 2 96 | +Sending 3 97 | +Got 3 98 | +Finished! 99 | - : unit = () 100 | ``` 101 | 102 | Because it doesn't support multiple threads or domains, it can detect deadlocks: 103 | 104 | ```ocaml 105 | # Eio_mock.Backend.run @@ fun () -> 106 | let p, _r = Promise.create () in 107 | Promise.await p;; 108 | Exception: Eio_mock__Backend.Deadlock_detected. 109 | ``` 110 | -------------------------------------------------------------------------------- /bench/bench_promise.ml: -------------------------------------------------------------------------------- 1 | open Eio.Std 2 | 3 | type request = { 4 | req_body : int; 5 | response : response option Promise.u; 6 | } 7 | and response = { 8 | resp_body : int; 9 | next_request : request Promise.u; 10 | } 11 | 12 | (* A client and server exchange these payload values. 13 | Each contains the current message and a resolver which the other party can use to reply. *) 14 | 15 | let rec run_server ~n_iters ~i r = 16 | (* Set up reply channel *) 17 | let p2, r2 = Promise.create () in 18 | (* Send i and next_request channel to client *) 19 | Promise.resolve r (Some { resp_body = i; next_request = r2 }); 20 | (* Await client's response, with new send channel *) 21 | let { req_body; response } = Promise.await p2 in 22 | assert (req_body = i); 23 | if i < n_iters then 24 | run_server ~n_iters ~i:(succ i) response 25 | else 26 | Promise.resolve response None 27 | 28 | let rec run_client ~n_iters ~i p = 29 | (* Wait for message and reply channel from server *) 30 | match Promise.await p with 31 | | Some { resp_body; next_request } -> 32 | assert (resp_body = i); 33 | (* Create new channel for next message *) 34 | let p2, r2 = Promise.create () in 35 | (* Send reply message and new channel to the server *) 36 | Promise.resolve next_request { req_body = i; response = r2 }; 37 | run_client ~n_iters ~i:(succ i) p2 38 | | None -> 39 | assert (i = n_iters + 1) 40 | 41 | let bench_resolved ~clock ~n_iters = 42 | let t0 = Eio.Time.now clock in 43 | let p = Promise.create_resolved 1 in 44 | let t = ref 0 in 45 | for _ = 1 to n_iters do 46 | t := !t + Promise.await p; 47 | done; 48 | let t1 = Eio.Time.now clock in 49 | Printf.printf "Reading a resolved promise: %.3f ns\n%!" (1e9 *. (t1 -. t0) /. float n_iters); 50 | assert (!t = n_iters) 51 | 52 | let run_bench ~domain_mgr ~clock ~use_domains ~n_iters = 53 | let init_p, init_r = Promise.create () in 54 | Gc.full_major (); 55 | let _minor0, prom0, _major0 = Gc.counters () in 56 | let t0 = Eio.Time.now clock in 57 | Fiber.both 58 | (fun () -> 59 | if use_domains then ( 60 | Eio.Domain_manager.run domain_mgr @@ fun () -> 61 | run_server ~n_iters ~i:0 init_r 62 | ) else ( 63 | run_server ~n_iters ~i:0 init_r 64 | ) 65 | ) 66 | (fun () -> 67 | run_client ~n_iters ~i:0 init_p 68 | ); 69 | let t1 = Eio.Time.now clock in 70 | let time_total = t1 -. t0 in 71 | let time_per_iter = time_total /. float n_iters in 72 | let _minor1, prom1, _major1 = Gc.counters () in 73 | let prom = prom1 -. prom0 in 74 | Printf.printf "%11b, %8d, %8.2f, %13.4f\n%!" use_domains n_iters (1e9 *. time_per_iter) (prom /. float n_iters) 75 | 76 | let main ~domain_mgr ~clock = 77 | bench_resolved ~clock ~n_iters:(10_000_000); 78 | Printf.printf "use_domains, n_iters, ns/iter, promoted/iter\n%!"; 79 | [false, 1_000_000; 80 | true, 100_000] 81 | |> List.iter (fun (use_domains, n_iters) -> 82 | run_bench ~domain_mgr ~clock ~use_domains ~n_iters 83 | ) 84 | 85 | let () = 86 | Eio_main.run @@ fun env -> 87 | main 88 | ~domain_mgr:(Eio.Stdenv.domain_mgr env) 89 | ~clock:(Eio.Stdenv.clock env) 90 | -------------------------------------------------------------------------------- /lib_eio/eio_mutex.mli: -------------------------------------------------------------------------------- 1 | (** A mutex can be used to ensure that only one piece of code can access a shared resource at one time. 2 | 3 | Unlike {!Stdlib.Mutex}, which blocks the whole domain while waiting to take the mutex, 4 | this module allows other Eio fibers to run while waiting. 5 | You should use this module if your critical section may perform blocking operations, 6 | while [Stdlib.Mutex] may be more efficient if the lock is held only briefly and 7 | the critial section does not switch fibers. 8 | 9 | Note that mutexes are often unnecessary for code running in a single domain, as 10 | the scheduler will only switch to another fiber if you perform an operation that 11 | can block. 12 | 13 | @canonical Eio.Mutex *) 14 | 15 | type t 16 | (** The type for a concurrency-friendly mutex. *) 17 | 18 | exception Poisoned of exn 19 | (** Raised if you attempt to use a mutex that has been disabled. *) 20 | 21 | val create : unit -> t 22 | (** [create ()] creates an initially unlocked mutex. *) 23 | 24 | val use_rw : protect:bool -> t -> (unit -> 'a) -> 'a 25 | (** [use_rw ~protect t fn] waits for the mutex to be free and then executes [fn ()] while holding the mutex locked. 26 | [fn] may mutate the resource protected by the mutex, 27 | but must ensure the resource is in a consistent state before returning. 28 | If [fn] raises an exception, the mutex is disabled and cannot be used again. 29 | @param protect If [true], uses {!Cancel.protect} to prevent the critical section from being cancelled. 30 | Cancellation is not prevented while waiting to take the lock. *) 31 | 32 | val use_ro : t -> (unit -> 'a) -> 'a 33 | (** [use_ro t fn] is like [use_rw ~protect:false], 34 | but if [fn] raises an exception it unlocks the mutex instead of disabling it. 35 | Use this if you only need read-only access to the mutex's resource and so 36 | know that it will be in a consistent state even if an exception is raised. 37 | 38 | Note: a mutex still only allows one fiber to have the mutex locked at a time, 39 | even if all operations are "read-only". *) 40 | 41 | (** {2 Low-level API} 42 | 43 | Care must be taken when locking a mutex manually. It is easy to forget to unlock it in some cases, 44 | which will result in deadlock the next time a fiber tries to use it. 45 | In particular, you need to consider: 46 | 47 | - What happens if your critical section raises an exception. 48 | - What happens if your fiber is cancelled while in its critical section. 49 | *) 50 | 51 | val lock : t -> unit 52 | (** Lock the given mutex. Only one fiber can have the mutex locked at any time. 53 | A fiber that attempts to lock a mutex already locked by another fiber 54 | will suspend until the other fiber unlocks the mutex. 55 | If no other fiber has the lock, this returns immediately without switching fibers. *) 56 | 57 | val unlock : t -> unit 58 | (** [unlock t] unlocks the mutex. 59 | @raises Sys_error if the mutex is unlocked. *) 60 | 61 | val try_lock : t -> bool 62 | (** Same as {!lock}, but does not suspend the calling thread if the mutex is already locked: 63 | just return [false] immediately in that case. If the mutex is unlocked, lock it and return [true]. *) 64 | -------------------------------------------------------------------------------- /lib_eio_linux/eio_stubs.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | 13 | #include 14 | #include 15 | #include 16 | #include 17 | #include 18 | #include 19 | 20 | // Make sure we have enough space for at least one entry. 21 | #define DIRENT_BUF_SIZE (PATH_MAX + sizeof(struct dirent64)) 22 | 23 | CAMLprim value caml_eio_eventfd(value v_initval) { 24 | int ret; 25 | ret = eventfd(Int_val(v_initval), EFD_CLOEXEC); 26 | if (ret == -1) uerror("eventfd", Nothing); 27 | return Val_int(ret); 28 | } 29 | 30 | CAMLprim value caml_eio_mkdirat(value v_fd, value v_path, value v_perm) { 31 | CAMLparam1(v_path); 32 | char *path; 33 | int ret; 34 | caml_unix_check_path(v_path, "mkdirat"); 35 | path = caml_stat_strdup(String_val(v_path)); 36 | caml_enter_blocking_section(); 37 | ret = mkdirat(Int_val(v_fd), path, Int_val(v_perm)); 38 | caml_leave_blocking_section(); 39 | caml_stat_free(path); 40 | if (ret == -1) uerror("mkdirat", v_path); 41 | CAMLreturn(Val_unit); 42 | } 43 | 44 | CAMLprim value caml_eio_renameat(value v_old_fd, value v_old_path, value v_new_fd, value v_new_path) { 45 | CAMLparam2(v_old_path, v_new_path); 46 | char *old_path; 47 | char *new_path; 48 | int ret; 49 | caml_unix_check_path(v_old_path, "renameat-old"); 50 | caml_unix_check_path(v_new_path, "renameat-new"); 51 | old_path = caml_stat_strdup(String_val(v_old_path)); 52 | new_path = caml_stat_strdup(String_val(v_new_path)); 53 | caml_enter_blocking_section(); 54 | ret = renameat(Int_val(v_old_fd), old_path, 55 | Int_val(v_new_fd), new_path); 56 | caml_leave_blocking_section(); 57 | caml_stat_free(old_path); 58 | caml_stat_free(new_path); 59 | if (ret == -1) uerror("renameat", v_old_path); 60 | CAMLreturn(Val_unit); 61 | } 62 | 63 | CAMLprim value caml_eio_getrandom(value v_ba, value v_off, value v_len) { 64 | CAMLparam1(v_ba); 65 | ssize_t ret; 66 | ssize_t off = (ssize_t)Long_val(v_off); 67 | ssize_t len = (ssize_t)Long_val(v_len); 68 | do { 69 | void *buf = Caml_ba_data_val(v_ba) + off; 70 | caml_enter_blocking_section(); 71 | ret = getrandom(buf, len, 0); 72 | caml_leave_blocking_section(); 73 | } while (ret == -1 && errno == EINTR); 74 | if (ret == -1) uerror("getrandom", Nothing); 75 | CAMLreturn(Val_long(ret)); 76 | } 77 | 78 | CAMLprim value caml_eio_getdents(value v_fd) { 79 | CAMLparam1(v_fd); 80 | CAMLlocal2(result, cons); 81 | char buf[DIRENT_BUF_SIZE]; 82 | struct dirent64 *d; 83 | int nread, pos; 84 | caml_enter_blocking_section(); 85 | nread = syscall(SYS_getdents64, Int_val(v_fd), buf, DIRENT_BUF_SIZE); 86 | caml_leave_blocking_section(); 87 | if (nread == -1) uerror("getdents", Nothing); 88 | 89 | result = Val_int(0); /* The empty list */ 90 | 91 | for (pos = 0; pos < nread;) { 92 | d = (struct dirent64 *) (buf + pos); 93 | cons = caml_alloc(2, 0); 94 | Store_field(cons, 0, caml_copy_string_of_os(d->d_name)); // Head 95 | Store_field(cons, 1, result); // Tail 96 | result = cons; 97 | pos += d->d_reclen; 98 | } 99 | 100 | CAMLreturn(result); 101 | } 102 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | Copyright (C) 2021 Anil Madhavapeddy 2 | Copyright (C) 2022 Thomas Leonard 3 | 4 | Permission to use, copy, modify, and distribute this software for any 5 | purpose with or without fee is hereby granted, provided that the above 6 | copyright notice and this permission notice appear in all copies. 7 | 8 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | 16 | 17 | This project includes some IPv6 code by Hugo Heuzard from ocaml-ipaddr, 18 | which has the following license: 19 | 20 | ISC License 21 | 22 | Copyright (c) 2013-2015 David Sheets 23 | Copyright (c) 2010-2011, 2014 Anil Madhavapeddy 24 | 25 | Permission to use, copy, modify, and distribute this software for any 26 | purpose with or without fee is hereby granted, provided that the above 27 | copyright notice and this permission notice appear in all copies. 28 | 29 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 30 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 31 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 32 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 33 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 34 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 35 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 36 | 37 | 38 | The `Eio.Buf_write` module is based on Faraday by Inhabited Type LLC, 39 | which has the following license (BSD-3-clause): 40 | 41 | Copyright (c) 2016, Inhabited Type LLC 42 | 43 | All rights reserved. 44 | 45 | Redistribution and use in source and binary forms, with or without 46 | modification, are permitted provided that the following conditions 47 | are met: 48 | 49 | 1. Redistributions of source code must retain the above copyright 50 | notice, this list of conditions and the following disclaimer. 51 | 52 | 2. Redistributions in binary form must reproduce the above copyright 53 | notice, this list of conditions and the following disclaimer in the 54 | documentation and/or other materials provided with the distribution. 55 | 56 | 3. Neither the name of the author nor the names of his contributors 57 | may be used to endorse or promote products derived from this software 58 | without specific prior written permission. 59 | 60 | THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS 61 | OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 62 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 63 | DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR 64 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 65 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 66 | OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 67 | HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, 68 | STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 69 | ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 70 | POSSIBILITY OF SUCH DAMAGE. 71 | -------------------------------------------------------------------------------- /lib_eio_luv/tests/poll.md: -------------------------------------------------------------------------------- 1 | # Set up the test environment 2 | 3 | ```ocaml 4 | # #require "eio_luv";; 5 | # open Eio.Std;; 6 | # open Eio;; 7 | ``` 8 | 9 | A helper function to create two sockets and pass their FDs to a function: 10 | 11 | ```ocaml 12 | let with_sockets fn = 13 | Eio_luv.run @@ fun _env -> 14 | Switch.run @@ fun sw -> 15 | let src, dst = Eio_unix.socketpair ~sw () in 16 | let src_fd = Option.get @@ Eio_unix.FD.peek_opt src in 17 | let dst_fd = Option.get @@ Eio_unix.FD.peek_opt dst in 18 | fn ~sw ((src, src_fd), (dst, dst_fd)) 19 | ``` 20 | 21 | Waiting for the same file descriptor to become writable does not raise `EEXIST`. 22 | 23 | ```ocaml 24 | # with_sockets @@ fun ~sw ((src, src_fd), (dst, dst_fd)) -> 25 | Eio.Fiber.both 26 | (fun () -> Eio_unix.await_writable src_fd) 27 | (fun () -> Eio_unix.await_writable src_fd);; 28 | - : unit = () 29 | ``` 30 | 31 | An example of reading and writing with different file descriptors. 32 | 33 | ```ocaml 34 | # with_sockets @@ fun ~sw ((src, src_fd), (dst, dst_fd)) -> 35 | let message = "hello" in 36 | let buffer = Buffer.create (String.length message) in 37 | Eio.Fiber.both 38 | (fun () -> 39 | Eio_unix.await_readable src_fd; 40 | Eio.Flow.copy src (Flow.buffer_sink buffer)) 41 | (fun () -> 42 | Eio_unix.await_writable dst_fd; 43 | Eio.Flow.copy_string message dst; 44 | Eio.Flow.close dst 45 | ); 46 | Buffer.contents buffer;; 47 | - : string = "hello" 48 | ``` 49 | 50 | Waiting for reading and writing on the same file descriptor. 51 | 52 | ```ocaml 53 | # with_sockets @@ fun ~sw ((src, src_fd), (dst, dst_fd)) -> 54 | let message = "hello" in 55 | let buffer = Buffer.create (String.length message) in 56 | Eio.Fiber.both 57 | (fun () -> 58 | Eio_unix.await_writable src_fd; 59 | Eio_unix.await_readable src_fd; 60 | Eio.Flow.copy src (Flow.buffer_sink buffer)) 61 | (fun () -> 62 | Eio_unix.await_writable dst_fd; 63 | Eio.Flow.copy_string message dst; 64 | Eio.Flow.close dst 65 | ); 66 | Buffer.contents buffer;; 67 | - : string = "hello" 68 | ``` 69 | 70 | Waiting for reading and writing on the same file descriptor, at the same time. 71 | 72 | ```ocaml 73 | # with_sockets @@ fun ~sw ((src, src_fd), (dst, dst_fd)) -> 74 | Eio.Fiber.both 75 | (fun () -> 76 | Eio_unix.await_readable src_fd) 77 | (fun () -> 78 | Eio_unix.await_writable src_fd; 79 | Eio.Flow.close dst);; 80 | - : unit = () 81 | ``` 82 | 83 | Cancelling a fiber removes a fiber but does not stop polling if others are still waiting. 84 | 85 | ```ocaml 86 | # with_sockets @@ fun ~sw ((src, src_fd), (dst, _dst_fd)) -> 87 | let buffer = Buffer.create 5 in 88 | Fiber.fork ~sw (fun () -> 89 | Eio_unix.await_readable src_fd; 90 | Eio.Flow.copy src (Flow.buffer_sink buffer); 91 | traceln "Still received: %s" (Buffer.contents buffer) 92 | ); 93 | (try 94 | Eio.Fiber.both 95 | (fun () -> Eio_unix.await_readable src_fd) 96 | (fun () -> raise (Failure "Simulate a cancel")) 97 | with 98 | exn -> traceln "%s" (Printexc.to_string exn)); 99 | Flow.copy_string "Hello" dst; 100 | Flow.close dst;; 101 | +Failure("Simulate a cancel") 102 | +Still received: Hello 103 | - : unit = () 104 | ``` 105 | 106 | Closing a file descriptor with an actively waiting poll fails the fiber that is waiting. 107 | 108 | ```ocaml 109 | # with_sockets @@ fun ~sw ((src, src_fd), (_dst, _dst_fd)) -> 110 | Eio.Fiber.both 111 | (fun () -> Eio_unix.await_readable src_fd) 112 | (fun () -> Eio.Flow.close src);; 113 | Exception: Failure "Closed file descriptor whilst polling". 114 | ``` 115 | -------------------------------------------------------------------------------- /lib_eio/mock/flow.ml: -------------------------------------------------------------------------------- 1 | open Eio.Std 2 | 3 | type copy_method = [ 4 | | `Read_into 5 | | `Read_source_buffer 6 | ] 7 | 8 | type t = < 9 | Eio.Flow.two_way; 10 | Eio.Flow.close; 11 | on_read : string Handler.t; 12 | on_copy_bytes : int Handler.t; 13 | set_copy_method : copy_method -> unit; 14 | attach_to_switch : Switch.t -> unit; 15 | > 16 | 17 | let pp_default f s = 18 | let rec aux i = 19 | let nl = 20 | match String.index_from_opt s i '\n' with 21 | | None -> String.length s 22 | | Some x -> x + 1 23 | in 24 | Fmt.Dump.string f (String.sub s i (nl - i)); 25 | if nl < String.length s then ( 26 | Fmt.cut f (); 27 | aux nl 28 | ) 29 | in 30 | aux 0 31 | 32 | let rec takev len = function 33 | | [] -> [] 34 | | x :: _ when Cstruct.length x >= len -> [Cstruct.sub x 0 len] 35 | | x :: xs -> x :: takev (len - Cstruct.length x) xs 36 | 37 | let make ?(pp=pp_default) label = 38 | let on_read = Handler.make (`Raise End_of_file) in 39 | let on_copy_bytes = Handler.make (`Return 4096) in 40 | let copy_method = ref `Read_into in 41 | (* Test optimised copying using Read_source_buffer *) 42 | let copy_rsb_iovec src = 43 | let size = Handler.run on_copy_bytes in 44 | let len = min (Cstruct.lenv src) size in 45 | let bufs = takev len src in 46 | traceln "%s: wrote (rsb) @[%a@]" label (Fmt.Dump.list (Fmt.using Cstruct.to_string pp)) bufs; 47 | len 48 | in 49 | let copy_rsb rsb = 50 | try while true do rsb copy_rsb_iovec done 51 | with End_of_file -> () 52 | in 53 | (* Test fallback copy using buffer. *) 54 | let copy_via_buffer src = 55 | try 56 | while true do 57 | let size = Handler.run on_copy_bytes in 58 | let buf = Cstruct.create size in 59 | let n = Eio.Flow.read src buf in 60 | traceln "%s: wrote @[%a@]" label pp (Cstruct.to_string (Cstruct.sub buf 0 n)) 61 | done 62 | with End_of_file -> () 63 | in 64 | object (self) 65 | inherit Eio.Flow.two_way 66 | 67 | val on_close = Queue.create () 68 | 69 | method on_read = on_read 70 | method on_copy_bytes = on_copy_bytes 71 | 72 | method read_into buf = 73 | let data = Handler.run on_read in 74 | let len = String.length data in 75 | if Cstruct.length buf < len then 76 | Fmt.failwith "%s: read buffer too short for %a!" label pp data; 77 | Cstruct.blit_from_string data 0 buf 0 len; 78 | traceln "%s: read @[%a@]" label pp data; 79 | len 80 | 81 | method copy src = 82 | match !copy_method with 83 | | `Read_into -> copy_via_buffer src 84 | | `Read_source_buffer -> 85 | let try_rsb = function 86 | | Eio.Flow.Read_source_buffer rsb -> copy_rsb rsb; true 87 | | _ -> false 88 | in 89 | if not (List.exists try_rsb (Eio.Flow.read_methods src)) then 90 | Fmt.failwith "Source does not offer Read_source_buffer optimisation" 91 | 92 | method set_copy_method m = 93 | copy_method := m 94 | 95 | method shutdown cmd = 96 | traceln "%s: shutdown %s" label @@ 97 | match cmd with 98 | | `Receive -> "receive" 99 | | `Send -> "send" 100 | | `All -> "all" 101 | 102 | method attach_to_switch sw = 103 | let hook = Switch.on_release_cancellable sw (fun () -> Eio.Flow.close self) in 104 | Queue.add (fun () -> Eio.Switch.remove_hook hook) on_close 105 | 106 | method close = 107 | while not (Queue.is_empty on_close) do 108 | Queue.take on_close () 109 | done; 110 | traceln "%s: closed" label 111 | end 112 | 113 | let on_read (t:t) = Handler.seq t#on_read 114 | let on_copy_bytes (t:t) = Handler.seq t#on_copy_bytes 115 | let set_copy_method (t:t) = t#set_copy_method 116 | let attach_to_switch (t:t) = t#attach_to_switch 117 | -------------------------------------------------------------------------------- /lib_eio/core/ctf.mli: -------------------------------------------------------------------------------- 1 | (** This library is used to write event traces in mirage-profile's CTF format. *) 2 | 3 | type id = private int 4 | (** Each thread/fiber/promise is identified by a unique ID. *) 5 | 6 | (** {2 Recording events} 7 | Libraries and applications can use these functions to make the traces more useful. *) 8 | 9 | val label : string -> unit 10 | (** [label msg] attaches text [msg] to the current thread. *) 11 | 12 | val note_increase : string -> int -> unit 13 | (** [note_increase counter delta] records that [counter] increased by [delta]. 14 | If [delta] is negative, this records a decrease. *) 15 | 16 | val note_counter_value : string -> int -> unit 17 | (** [note_counter_value counter value] records that [counter] is now [value]. *) 18 | 19 | val should_resolve : id -> unit 20 | (** [should_resolve id] records that [id] is expected to resolve, and should be highlighted if it doesn't. *) 21 | 22 | (** {2 Recording system events} 23 | These are normally only called by the scheduler. *) 24 | 25 | type hiatus_reason = 26 | | Wait_for_work 27 | | Suspend 28 | | Hibernate 29 | 30 | type event = 31 | | Wait 32 | | Task 33 | | Bind 34 | | Try 35 | | Choose 36 | | Pick 37 | | Join 38 | | Map 39 | | Condition 40 | | On_success 41 | | On_failure 42 | | On_termination 43 | | On_any 44 | | Ignore_result 45 | | Async 46 | | Promise 47 | | Semaphore 48 | | Switch 49 | | Stream 50 | | Mutex 51 | (** Types of threads or other recorded objects. *) 52 | 53 | val mint_id : unit -> id 54 | (** [mint_id ()] is a fresh unique [id]. *) 55 | 56 | val note_created : ?label:string -> id -> event -> unit 57 | (** [note_created t id ty] records the creation of [id]. *) 58 | 59 | val note_read : ?reader:id -> id -> unit 60 | (** [note_read src] records that promise [src]'s value was read. 61 | @param reader The thread doing the read (default is the current thread). *) 62 | 63 | val note_try_read : id -> unit 64 | (** [note_try_read src] records that the current thread wants to read from [src] (which is not currently ready). *) 65 | 66 | val note_switch : id -> unit 67 | (** [note_switch id] records that [id] is now the current thread. *) 68 | 69 | val note_hiatus : hiatus_reason -> unit 70 | (** [note_hiatus r] records that the system will sleep for reason [r]. *) 71 | 72 | val note_resume : id -> unit 73 | (** [note_resume id] records that the system has resumed (used after {!note_hiatus}), 74 | and is now running [id]. *) 75 | 76 | val note_fork : unit -> id 77 | (** [note_fork ()] records that a new thread has been forked and returns a fresh ID for it. *) 78 | 79 | val note_resolved : id -> ex:exn option -> unit 80 | (** [note_resolved id ~ex] records that [id] is now resolved. 81 | If [ex = None] then [id] was successful, otherwise it failed with exception [ex]. *) 82 | 83 | val note_signal : ?src:id -> id -> unit 84 | (** [note_signal ~src dst] records that [dst] was signalled. 85 | @param src The thread sending the signal (default is the current thread). *) 86 | 87 | (** {2 Controlling tracing} *) 88 | 89 | type log_buffer = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t 90 | 91 | module Control : sig 92 | type t 93 | 94 | val make : timestamper:(log_buffer -> int -> unit) -> log_buffer -> t 95 | (** [make ~timestamper b] is a trace buffer that record events in [b]. 96 | In most cases, the {!Ctf_unix} module provides a simpler interface. *) 97 | 98 | val start : t -> unit 99 | (** [start t] begins recording events in [t]. *) 100 | 101 | val stop : t -> unit 102 | (** [stop t] stops recording to [t] (which must be the current trace buffer). *) 103 | end 104 | 105 | (**/**) 106 | 107 | module BS : sig 108 | val set_int8 : Cstruct.buffer -> int -> int -> unit 109 | val set_int64_le : Cstruct.buffer -> int -> int64 -> unit 110 | end 111 | -------------------------------------------------------------------------------- /lib_eio/mock/net.ml: -------------------------------------------------------------------------------- 1 | open Eio.Std 2 | 3 | type t = < 4 | Eio.Net.t; 5 | on_listen : Eio.Net.listening_socket Handler.t; 6 | on_connect : Handler.t; 7 | on_datagram_socket : Handler.t; 8 | on_getaddrinfo : Eio.Net.Sockaddr.t list Handler.t; 9 | on_getnameinfo : (string * string) Handler.t; 10 | > 11 | 12 | let make label = 13 | let on_listen = Handler.make (`Raise (Failure "Mock listen handler not configured")) in 14 | let on_connect = Handler.make (`Raise (Failure "Mock connect handler not configured")) in 15 | let on_datagram_socket = Handler.make (`Raise (Failure "Mock datagram_socket handler not configured")) in 16 | let on_getaddrinfo = Handler.make (`Raise (Failure "Mock getaddrinfo handler not configured")) in 17 | let on_getnameinfo = Handler.make (`Raise (Failure "Mock getnameinfo handler not configured")) in 18 | object 19 | inherit Eio.Net.t 20 | 21 | method on_listen = on_listen 22 | method on_connect = on_connect 23 | method on_datagram_socket = on_datagram_socket 24 | method on_getaddrinfo = on_getaddrinfo 25 | method on_getnameinfo = on_getnameinfo 26 | 27 | method listen ~reuse_addr:_ ~reuse_port:_ ~backlog:_ ~sw addr = 28 | traceln "%s: listen on %a" label Eio.Net.Sockaddr.pp addr; 29 | let socket = Handler.run on_listen in 30 | Switch.on_release sw (fun () -> Eio.Flow.close socket); 31 | socket 32 | 33 | method connect ~sw addr = 34 | traceln "%s: connect to %a" label Eio.Net.Sockaddr.pp addr; 35 | let socket = Handler.run on_connect in 36 | Switch.on_release sw (fun () -> Eio.Flow.close socket); 37 | socket 38 | 39 | method datagram_socket ~sw addr = 40 | traceln "%s: datagram_socket %a" label Eio.Net.Sockaddr.pp addr; 41 | let socket = Handler.run on_datagram_socket in 42 | Switch.on_release sw (fun () -> Eio.Flow.close socket); 43 | socket 44 | 45 | method getaddrinfo ~service node = 46 | traceln "%s: getaddrinfo ~service:%s %s" label service node; 47 | Handler.run on_getaddrinfo 48 | 49 | method getnameinfo sockaddr = 50 | traceln "%s: getnameinfo %a" label Eio.Net.Sockaddr.pp sockaddr; 51 | Handler.run on_getnameinfo 52 | end 53 | 54 | let on_connect (t:t) actions = 55 | let as_socket x = (x :> ) in 56 | Handler.seq t#on_connect (List.map (Action.map as_socket) actions) 57 | 58 | let on_listen (t:t) actions = 59 | let as_socket x = (x :> ) in 60 | Handler.seq t#on_listen (List.map (Action.map as_socket) actions) 61 | 62 | let on_datagram_socket (t:t) actions = 63 | let as_socket x = (x :> ) in 64 | Handler.seq t#on_datagram_socket (List.map (Action.map as_socket) actions) 65 | 66 | let on_getaddrinfo (t:t) actions = Handler.seq t#on_getaddrinfo actions 67 | 68 | let on_getnameinfo (t:t) actions = Handler.seq t#on_getnameinfo actions 69 | 70 | type listening_socket = < 71 | Eio.Net.listening_socket; 72 | on_accept : (Flow.t * Eio.Net.Sockaddr.stream) Handler.t; 73 | > 74 | 75 | let listening_socket label = 76 | let on_accept = Handler.make (`Raise (Failure "Mock accept handler not configured")) in 77 | object 78 | inherit Eio.Net.listening_socket 79 | 80 | method on_accept = on_accept 81 | 82 | method accept ~sw = 83 | let socket, addr = Handler.run on_accept in 84 | Flow.attach_to_switch socket sw; 85 | traceln "%s: accepted connection from %a" label Eio.Net.Sockaddr.pp addr; 86 | (socket :> ), addr 87 | 88 | method close = 89 | traceln "%s: closed" label 90 | end 91 | 92 | let on_accept (l:listening_socket) actions = 93 | let as_accept_pair x = (x :> Flow.t * Eio.Net.Sockaddr.stream) in 94 | Handler.seq l#on_accept (List.map (Action.map as_accept_pair) actions) 95 | -------------------------------------------------------------------------------- /tests/condition.md: -------------------------------------------------------------------------------- 1 | # Setting up the environment 2 | 3 | ```ocaml 4 | # #require "eio.mock";; 5 | ``` 6 | 7 | ```ocaml 8 | open Eio.Std 9 | 10 | module C = Eio.Condition 11 | ``` 12 | 13 | # Test cases 14 | 15 | Simple case: 16 | 17 | ```ocaml 18 | # Eio_mock.Backend.run @@ fun () -> 19 | Switch.run @@ fun sw -> 20 | let condition = C.create () in 21 | Fiber.both 22 | (fun () -> 23 | traceln "1: wait for condition"; 24 | C.await_no_mutex condition; 25 | traceln "1: finished") 26 | (fun () -> 27 | traceln "2: broadcast condition"; 28 | C.broadcast condition; 29 | traceln "2: finished");; 30 | +1: wait for condition 31 | +2: broadcast condition 32 | +2: finished 33 | +1: finished 34 | - : unit = () 35 | ``` 36 | 37 | Broadcast when no one is waiting doesn't block: 38 | 39 | ```ocaml 40 | # Eio_mock.Backend.run @@ fun () -> 41 | Switch.run @@ fun sw -> 42 | let condition = C.create () in 43 | traceln "broadcast condition"; 44 | C.broadcast condition; 45 | traceln "finished";; 46 | +broadcast condition 47 | +finished 48 | - : unit = () 49 | ``` 50 | 51 | Broadcast wakes all waiters at once: 52 | 53 | ```ocaml 54 | # Eio_mock.Backend.run @@ fun () -> 55 | Switch.run @@ fun sw -> 56 | let condition = C.create () in 57 | Fiber.all [ 58 | (fun () -> 59 | traceln "1: wait for condition"; 60 | C.await_no_mutex condition; 61 | traceln "1: finished"); 62 | (fun () -> 63 | traceln "2: wait for condition"; 64 | C.await_no_mutex condition; 65 | traceln "2: finished"); 66 | (fun () -> 67 | traceln "3: broadcast condition"; 68 | C.broadcast condition; 69 | traceln "3: finished") 70 | ];; 71 | +1: wait for condition 72 | +2: wait for condition 73 | +3: broadcast condition 74 | +3: finished 75 | +1: finished 76 | +2: finished 77 | - : unit = () 78 | ``` 79 | 80 | ## Typical single-domain use 81 | 82 | ```ocaml 83 | let x = ref 0 84 | let cond = Eio.Condition.create () 85 | 86 | let set value = 87 | x := value; 88 | Eio.Condition.broadcast cond 89 | 90 | let await p = 91 | (* Warning: only safe within a single-domain, and if [p] doesn't switch fibers! *) 92 | while not (p !x) do 93 | Eio.Condition.await_no_mutex cond 94 | done 95 | ``` 96 | 97 | ```ocaml 98 | # Eio_mock.Backend.run @@ fun () -> 99 | Fiber.both 100 | (fun () -> 101 | traceln "x = %d" !x; 102 | await ((=) 42); 103 | traceln "x = %d" !x 104 | ) 105 | (fun () -> 106 | set 5; 107 | Fiber.yield (); 108 | set 7; 109 | set 42; 110 | );; 111 | +x = 0 112 | +x = 42 113 | - : unit = () 114 | ``` 115 | 116 | ## Use with mutex 117 | 118 | ```ocaml 119 | let x = ref 0 120 | let cond = Eio.Condition.create () 121 | let mutex = Eio.Mutex.create () 122 | 123 | let set value = 124 | Eio.Mutex.use_rw ~protect:false mutex (fun () -> x := value); 125 | Eio.Condition.broadcast cond 126 | 127 | let await p = 128 | Eio.Mutex.use_ro mutex (fun () -> 129 | while not (p !x) do 130 | Eio.Condition.await cond mutex 131 | done 132 | ) 133 | ``` 134 | 135 | ```ocaml 136 | # Eio_mock.Backend.run @@ fun () -> 137 | Fiber.both 138 | (fun () -> 139 | traceln "x = %d" !x; 140 | await ((=) 42); 141 | traceln "x = %d" !x 142 | ) 143 | (fun () -> 144 | set 5; 145 | Fiber.yield (); 146 | set 7; 147 | set 42; 148 | );; 149 | +x = 0 150 | +x = 42 151 | - : unit = () 152 | ``` 153 | 154 | Cancellation while waiting: 155 | 156 | ```ocaml 157 | # Eio_mock.Backend.run @@ fun () -> 158 | Fiber.first 159 | (fun () -> 160 | await ((=) 0); 161 | assert false; 162 | ) 163 | (fun () -> ()); 164 | Fiber.both 165 | (fun () -> 166 | traceln "x = %d" !x; 167 | await ((=) 0); 168 | traceln "x = %d" !x 169 | ) 170 | (fun () -> 171 | set 5; 172 | Fiber.yield (); 173 | set 0; 174 | );; 175 | +x = 42 176 | +x = 0 177 | - : unit = () 178 | ``` 179 | -------------------------------------------------------------------------------- /lib_eio/eio_mutex.ml: -------------------------------------------------------------------------------- 1 | type state = 2 | | Unlocked (* can be locked *) 3 | | Locked (* is locked; threads may be waiting *) 4 | | Poisoned of exn (* disabled due to exception in critical section *) 5 | 6 | exception Poisoned of exn 7 | 8 | type t = { 9 | id : Ctf.id; 10 | mutex : Mutex.t; 11 | mutable state : state; (* Owned by [t.mutex] *) 12 | waiters : [`Take | `Error of exn] Waiters.t; (* Owned by [t.mutex] *) 13 | } 14 | (* Invariant: t.state <> Locked -> is_empty t.waiters *) 15 | 16 | (* When [t.state = Unlocked], [t] owns the user resource that [t] protects. 17 | [mutex t R] means [t] is a share of a reference to a mutex with an invariant R. 18 | [locked t] means the holder has the ability to unlock [t]. *) 19 | 20 | (* {R} t = create () {mutex t R} *) 21 | let create () = 22 | let id = Ctf.mint_id () in 23 | Ctf.note_created id Ctf.Mutex; 24 | { 25 | id; 26 | mutex = Mutex.create (); 27 | state = Unlocked; (* Takes ownership of R *) 28 | waiters = Waiters.create (); 29 | } 30 | 31 | (* {mutex t R * locked t * R} unlock t {mutex t R} 32 | If [t] is in an invalid state, it raises an exception and nothing changes. *) 33 | let unlock t = 34 | Mutex.lock t.mutex; 35 | (* We now have ownership of [t.state] and [t.waiters]. *) 36 | Ctf.note_signal t.id; 37 | match t.state with 38 | | Unlocked -> 39 | Mutex.unlock t.mutex; 40 | let ex = Sys_error "Eio.Mutex.unlock: already unlocked!" in 41 | t.state <- Poisoned ex; 42 | raise ex 43 | | Locked -> 44 | begin match Waiters.wake_one t.waiters `Take with 45 | | `Ok -> () (* We transferred [locked t * R] to a waiter; [t] remains [Locked]. *) 46 | | `Queue_empty -> t.state <- Unlocked (* The state now owns R. *) 47 | end; 48 | Mutex.unlock t.mutex 49 | | Poisoned ex -> 50 | Mutex.unlock t.mutex; 51 | raise (Poisoned ex) 52 | 53 | (* {mutex t R} lock t {mutex t R * locked t * R} *) 54 | let lock t = 55 | Mutex.lock t.mutex; 56 | match t.state with 57 | | Locked -> 58 | Ctf.note_try_read t.id; 59 | begin match Waiters.await ~mutex:(Some t.mutex) t.waiters t.id with 60 | | `Error ex -> raise ex (* Poisoned; stop waiting *) 61 | | `Take -> 62 | (* The unlocker didn't change the state, so it's still Locked, as required. 63 | {locked t * R} *) 64 | () 65 | end 66 | | Unlocked -> 67 | Ctf.note_read t.id; 68 | t.state <- Locked; (* We transfer R from the state to our caller. *) 69 | (* {locked t * R} *) 70 | Mutex.unlock t.mutex 71 | | Poisoned ex -> 72 | Mutex.unlock t.mutex; 73 | raise (Poisoned ex) 74 | 75 | (* {mutex t R} v = try_lock t { mutex t R * if v then locked t * R else [] } *) 76 | let try_lock t = 77 | Mutex.lock t.mutex; 78 | match t.state with 79 | | Locked -> 80 | Ctf.note_try_read t.id; 81 | Mutex.unlock t.mutex; 82 | false 83 | | Unlocked -> 84 | Ctf.note_read t.id; 85 | t.state <- Locked; (* We transfer R from the state to our caller. *) 86 | Mutex.unlock t.mutex; 87 | (* {locked t * R} *) 88 | true 89 | | Poisoned ex -> 90 | Mutex.unlock t.mutex; 91 | raise (Poisoned ex) 92 | 93 | (* {mutex t R * locked t} poison t ex {mutex t R} *) 94 | let poison t ex = 95 | Mutex.lock t.mutex; 96 | t.state <- Poisoned ex; 97 | Waiters.wake_all t.waiters (`Error (Poisoned ex)); 98 | Mutex.unlock t.mutex 99 | 100 | (* {locked t * R} fn () {locked t * R} -> 101 | {mutex t R} use_ro t fn {mutex t R} *) 102 | let use_ro t fn = 103 | lock t; 104 | (* {mutex t R * locked t * R} *) 105 | match fn () with 106 | | x -> unlock t; x 107 | | exception ex -> unlock t; raise ex 108 | 109 | (* {locked t * R} v = match fn () with _ -> true | exception _ -> false {locked t * if v then R else []} -> 110 | {mutex t R} use_rw ~protect t fn {mutex t R} *) 111 | let use_rw ~protect t fn = 112 | lock t; 113 | (* {mutex t R * locked t * R} *) 114 | match if protect then Cancel.protect fn else fn () with 115 | | x -> unlock t; x 116 | | exception ex -> 117 | (* {mutex t R * locked t} *) 118 | poison t ex; 119 | raise ex 120 | -------------------------------------------------------------------------------- /lib_eio/flow.mli: -------------------------------------------------------------------------------- 1 | (** Flows are used to represent byte streams, such as open files and network sockets. 2 | A {!source} provides a stream of bytes. A {!sink} consumes a stream. 3 | A {!two_way} can do both. 4 | 5 | To read structured data (e.g. a line at a time), wrap a source using {!Buf_read}. *) 6 | 7 | (** {2 Reading} *) 8 | 9 | type read_method = .. 10 | (** Sources can offer a list of ways to read them, in order of preference. *) 11 | 12 | class virtual source : object 13 | inherit Generic.t 14 | method read_methods : read_method list 15 | method virtual read_into : Cstruct.t -> int 16 | end 17 | 18 | val read : #source -> Cstruct.t -> int 19 | (** [read src buf] reads one or more bytes into [buf]. 20 | 21 | It returns the number of bytes read (which may be less than the 22 | buffer size even if there is more data to be read). 23 | [read src] just makes a single call to [src#read_into] 24 | (and asserts that the result is in range). 25 | 26 | - Use {!read_exact} instead if you want to fill [buf] completely. 27 | - Use {!Buf_read.line} to read complete lines. 28 | - Use {!copy} to stream data directly from a source to a sink. 29 | 30 | [buf] must not be zero-length. 31 | 32 | @raise End_of_file if there is no more data to read *) 33 | 34 | val read_exact : #source -> Cstruct.t -> unit 35 | (** [read_exact src dst] keeps reading into [dst] until it is full. 36 | @raise End_of_file if the buffer could not be filled. *) 37 | 38 | val read_methods : #source -> read_method list 39 | (** [read_methods flow] is a list of extra ways of reading from [flow], 40 | with the preferred (most efficient) methods first. 41 | 42 | If no method is suitable, {!read} should be used as the fallback. *) 43 | 44 | val string_source : string -> source 45 | (** [string_source s] is a source that gives the bytes of [s]. *) 46 | 47 | val cstruct_source : Cstruct.t list -> source 48 | (** [cstruct_source cs] is a source that gives the bytes of [cs]. *) 49 | 50 | type read_method += Read_source_buffer of ((Cstruct.t list -> int) -> unit) 51 | (** If a source offers [Read_source_buffer rsb] then the user can call [rsb fn] 52 | to borrow a view of the source's buffers. [fn] returns the number of bytes it consumed. 53 | 54 | [rsb] will raise [End_of_file] if no more data will be produced. 55 | If no data is currently available, [rsb] will wait for some to become available before calling [fn]. 56 | 57 | [fn] must not continue to use the buffers after it returns. *) 58 | 59 | (** {2 Writing} *) 60 | 61 | (** Consumer base class. *) 62 | class virtual sink : object 63 | inherit Generic.t 64 | method virtual copy : 'a. (#source as 'a) -> unit 65 | end 66 | 67 | val copy : #source -> #sink -> unit 68 | (** [copy src dst] copies data from [src] to [dst] until end-of-file. *) 69 | 70 | val copy_string : string -> #sink -> unit 71 | (** [copy_string s = copy (string_source s)] *) 72 | 73 | val buffer_sink : Buffer.t -> sink 74 | (** [buffer_sink b] is a sink that adds anything sent to it to [b]. 75 | 76 | To collect data as a cstruct, use {!Buf_read} instead. *) 77 | 78 | (** {2 Bidirectional streams} *) 79 | 80 | type shutdown_command = [ 81 | | `Receive (** Indicate that no more reads will be done *) 82 | | `Send (** Indicate that no more writes will be done *) 83 | | `All (** Indicate that no more reads or writes will be done *) 84 | ] 85 | 86 | class virtual two_way : object 87 | inherit source 88 | inherit sink 89 | 90 | method virtual shutdown : shutdown_command -> unit 91 | end 92 | 93 | val shutdown : #two_way -> shutdown_command -> unit 94 | (** [shutdown t cmd] indicates that the caller has finished reading or writing [t] 95 | (depending on [cmd]). 96 | 97 | This is useful in some protocols to indicate that you have finished sending the request, 98 | and that the remote peer should now send the response. *) 99 | 100 | (** {2 Closing} 101 | 102 | Flows are usually attached to switches and closed automatically when the switch 103 | finishes. However, it can be useful to close them sooner manually in some cases. *) 104 | 105 | class type close = object 106 | method close : unit 107 | end 108 | 109 | val close : #close -> unit 110 | (** [close t] marks the flow as closed. It can no longer be used after this. *) 111 | -------------------------------------------------------------------------------- /lib_eio/path.mli: -------------------------------------------------------------------------------- 1 | (** A [_ Path.t] represents a particular location in some filesystem. 2 | It is a pair of a base directory and a relative path from there. 3 | 4 | {!Eio.Stdenv.cwd} provides access to the current working directory. 5 | For example: 6 | 7 | {[ 8 | let ( / ) = Eio.Path.( / ) 9 | 10 | let run dir = 11 | Eio.Path.save ~create:(`Exclusive 0o600) 12 | (dir / "output.txt") "the data" 13 | 14 | let () = 15 | Eio_main.run @@ fun env -> 16 | run (Eio.Stdenv.cwd env) 17 | ]} 18 | 19 | It is normally not permitted to access anything above the base directory, 20 | even by following a symlink. 21 | The exception is {!Stdenv.fs}, which provides access to the whole file-system: 22 | 23 | {[ 24 | Eio.Path.load (fs / "/etc/passwd") 25 | ]} 26 | *) 27 | 28 | open Fs 29 | 30 | type 'a t = (#Fs.dir as 'a) * path 31 | (** An OS directory FD and a path relative to it, for use with e.g. [openat(2)]. *) 32 | 33 | val ( / ) : 'a t -> string -> 'a t 34 | (** [t / step] is [t] with [step] appended to [t]'s path, 35 | or replacing [t]'s path if [step] is absolute: 36 | 37 | - [(fd, "foo") / "bar" = (fd, "foo/bar")] 38 | - [(fd, "foo") / "/bar" = (fd, "/bar")] *) 39 | 40 | val pp : _ t Fmt.t 41 | (** [pp] formats a [_ t] as "", suitable for logging. *) 42 | 43 | (** {1 Reading files} *) 44 | 45 | val load : _ t -> string 46 | (** [load t] returns the contents of the given file. 47 | 48 | This is a convenience wrapper around {!with_open_in}. *) 49 | 50 | val open_in : sw:Switch.t -> _ t -> 51 | (** [open_in ~sw t] opens [t] for reading. 52 | 53 | Note: files are always opened in binary mode. *) 54 | 55 | val with_open_in : _ t -> ( -> 'a) -> 'a 56 | (** [with_open_in] is like [open_in], but calls [fn flow] with the new flow and closes 57 | it automatically when [fn] returns (if it hasn't already been closed by then). *) 58 | 59 | val with_lines : _ t -> (string Seq.t -> 'a) -> 'a 60 | (** [with_lines t fn] is a convenience function for streaming the lines of the file. 61 | 62 | It uses {!Buf_read.lines}. *) 63 | 64 | (** {1 Writing files} *) 65 | 66 | val save : ?append:bool -> create:create -> _ t -> string -> unit 67 | (** [save t data ~create] writes [data] to [t]. 68 | 69 | This is a convenience wrapper around {!with_open_out}. *) 70 | 71 | val open_out : 72 | sw:Switch.t -> 73 | ?append:bool -> 74 | create:create -> 75 | _ t -> 76 | (** [open_out ~sw t] opens [t] for reading and writing. 77 | 78 | Note: files are always opened in binary mode. 79 | @param append Open for appending: always write at end of file. 80 | @param create Controls whether to create the file, and what permissions to give it if so. *) 81 | 82 | val with_open_out : 83 | ?append:bool -> 84 | create:create -> 85 | _ t -> ( -> 'a) -> 'a 86 | (** [with_open_out] is like [open_out], but calls [fn flow] with the new flow and closes 87 | it automatically when [fn] returns (if it hasn't already been closed by then). *) 88 | 89 | (** {1 Directories} *) 90 | 91 | val mkdir : perm:Unix_perm.t -> _ t -> unit 92 | (** [mkdir ~perm t] creates a new directory [t] with permissions [perm]. *) 93 | 94 | val open_dir : sw:Switch.t -> _ t -> t 95 | (** [open_dir ~sw t] opens [t]. 96 | 97 | This can be passed to functions to grant access only to the subtree [t]. *) 98 | 99 | val with_open_dir : _ t -> ( t -> 'a) -> 'a 100 | (** [with_open_dir] is like [open_dir], but calls [fn dir] with the new directory and closes 101 | it automatically when [fn] returns (if it hasn't already been closed by then). *) 102 | 103 | val read_dir : _ t -> string list 104 | (** [read_dir t] reads directory entries for [t]. The entries are sorted using {! String.compare}.*) 105 | 106 | (** {1 Other} *) 107 | 108 | val unlink : _ t -> unit 109 | (** [unlink t] removes directory entry [t]. 110 | 111 | Note: this cannot be used to unlink directories. 112 | Use {!rmdir} for directories. *) 113 | 114 | val rmdir : _ t -> unit 115 | (** [rmdir t] removes directory entry [t]. 116 | This only works when the entry is itself a directory. 117 | 118 | Note: this usually requires the directory to be empty. *) 119 | 120 | val rename : _ t -> _ t -> unit 121 | (** [rename old_t new_t] atomically unlinks [old_t] and links it as [new_t]. 122 | 123 | If [new_t] already exists, it is atomically replaced. *) 124 | -------------------------------------------------------------------------------- /lib_eio_linux/tests/test.ml: -------------------------------------------------------------------------------- 1 | open Eio.Std 2 | 3 | module Ctf = Eio.Private.Ctf 4 | 5 | let () = 6 | Logs.(set_level ~all:true (Some Debug)); 7 | Logs.set_reporter @@ Logs.format_reporter (); 8 | Printexc.record_backtrace true 9 | 10 | let read_one_byte ~sw r = 11 | Fiber.fork_promise ~sw (fun () -> 12 | let r = Option.get (Eio_linux.get_fd_opt r) in 13 | Eio_linux.Low_level.await_readable r; 14 | let b = Bytes.create 1 in 15 | let got = Unix.read (Eio_linux.FD.to_unix `Peek r) b 0 1 in 16 | assert (got = 1); 17 | Bytes.to_string b 18 | ) 19 | 20 | let test_poll_add () = 21 | Eio_linux.run @@ fun _stdenv -> 22 | Switch.run @@ fun sw -> 23 | let r, w = Eio_linux.pipe sw in 24 | let thread = read_one_byte ~sw r in 25 | Fiber.yield (); 26 | let w = Option.get (Eio_linux.get_fd_opt w) in 27 | Eio_linux.Low_level.await_writable w; 28 | let sent = Unix.write (Eio_linux.FD.to_unix `Peek w) (Bytes.of_string "!") 0 1 in 29 | assert (sent = 1); 30 | let result = Promise.await_exn thread in 31 | Alcotest.(check string) "Received data" "!" result 32 | 33 | let test_poll_add_busy () = 34 | Eio_linux.run ~queue_depth:2 @@ fun _stdenv -> 35 | Switch.run @@ fun sw -> 36 | let r, w = Eio_linux.pipe sw in 37 | let a = read_one_byte ~sw r in 38 | let b = read_one_byte ~sw r in 39 | Fiber.yield (); 40 | let w = Option.get (Eio_linux.get_fd_opt w) |> Eio_linux.FD.to_unix `Peek in 41 | let sent = Unix.write w (Bytes.of_string "!!") 0 2 in 42 | assert (sent = 2); 43 | let a = Promise.await_exn a in 44 | Alcotest.(check string) "Received data" "!" a; 45 | let b = Promise.await_exn b in 46 | Alcotest.(check string) "Received data" "!" b 47 | 48 | (* Write a string to a pipe and read it out again. *) 49 | let test_copy () = 50 | Eio_linux.run ~queue_depth:3 @@ fun _stdenv -> 51 | Switch.run @@ fun sw -> 52 | let msg = "Hello!" in 53 | let from_pipe, to_pipe = Eio_linux.pipe sw in 54 | let buffer = Buffer.create 20 in 55 | Fiber.both 56 | (fun () -> Eio.Flow.copy from_pipe (Eio.Flow.buffer_sink buffer)) 57 | (fun () -> 58 | Eio.Flow.copy (Eio.Flow.string_source msg) to_pipe; 59 | Eio.Flow.copy (Eio.Flow.string_source msg) to_pipe; 60 | Eio.Flow.close to_pipe 61 | ); 62 | Alcotest.(check string) "Copy correct" (msg ^ msg) (Buffer.contents buffer); 63 | Eio.Flow.close from_pipe 64 | 65 | (* Write a string via 2 pipes. The copy from the 1st to 2nd pipe will be optimised and so tests a different code-path. *) 66 | let test_direct_copy () = 67 | Eio_linux.run ~queue_depth:4 @@ fun _stdenv -> 68 | Switch.run @@ fun sw -> 69 | let msg = "Hello!" in 70 | let from_pipe1, to_pipe1 = Eio_linux.pipe sw in 71 | let from_pipe2, to_pipe2 = Eio_linux.pipe sw in 72 | let buffer = Buffer.create 20 in 73 | let to_output = Eio.Flow.buffer_sink buffer in 74 | Switch.run (fun sw -> 75 | Fiber.fork ~sw (fun () -> Ctf.label "copy1"; Eio.Flow.copy from_pipe1 to_pipe2; Eio.Flow.close to_pipe2); 76 | Fiber.fork ~sw (fun () -> Ctf.label "copy2"; Eio.Flow.copy from_pipe2 to_output); 77 | Eio.Flow.copy (Eio.Flow.string_source msg) to_pipe1; 78 | Eio.Flow.close to_pipe1; 79 | ); 80 | Alcotest.(check string) "Copy correct" msg (Buffer.contents buffer); 81 | Eio.Flow.close from_pipe1; 82 | Eio.Flow.close from_pipe2 83 | 84 | (* Read and write using IO vectors rather than the fixed buffers. *) 85 | let test_iovec () = 86 | Eio_linux.run ~queue_depth:4 @@ fun _stdenv -> 87 | Switch.run @@ fun sw -> 88 | let from_pipe, to_pipe = Eio_linux.pipe sw in 89 | let from_pipe = Eio_linux.get_fd from_pipe in 90 | let to_pipe = Eio_linux.get_fd to_pipe in 91 | let message = Cstruct.of_string "Got [ ] and [ ]" in 92 | let rec recv = function 93 | | [] -> () 94 | | cs -> 95 | let got = Eio_linux.Low_level.readv from_pipe cs in 96 | recv (Cstruct.shiftv cs got) 97 | in 98 | Fiber.both 99 | (fun () -> recv [Cstruct.sub message 5 3; Cstruct.sub message 15 3]) 100 | (fun () -> 101 | let b = Cstruct.of_string "barfoo" in 102 | Eio_linux.Low_level.writev to_pipe [Cstruct.sub b 3 3; Cstruct.sub b 0 3]; 103 | Eio_linux.FD.close to_pipe 104 | ); 105 | Alcotest.(check string) "Transfer correct" "Got [foo] and [bar]" (Cstruct.to_string message) 106 | 107 | let () = 108 | let open Alcotest in 109 | run "eio_linux" [ 110 | "io", [ 111 | test_case "copy" `Quick test_copy; 112 | test_case "direct_copy" `Quick test_direct_copy; 113 | test_case "poll_add" `Quick test_poll_add; 114 | test_case "poll_add_busy" `Quick test_poll_add_busy; 115 | test_case "iovec" `Quick test_iovec; 116 | ]; 117 | ] 118 | -------------------------------------------------------------------------------- /lib_eio/unix/eio_unix.mli: -------------------------------------------------------------------------------- 1 | (** Extension of {!Eio} for integration with OCaml's [Unix] module. 2 | 3 | Note that OCaml's [Unix] module is not safe, and therefore care must be taken when using these functions. 4 | For example, it is possible to leak file descriptors this way, or to use them after they've been closed, 5 | allowing one module to corrupt a file belonging to an unrelated module. *) 6 | 7 | open Eio.Std 8 | 9 | type unix_fd = < 10 | unix_fd : [`Peek | `Take] -> Unix.file_descr; 11 | > 12 | 13 | type socket = < 14 | Eio.Flow.two_way; 15 | Eio.Flow.close; 16 | unix_fd; 17 | > 18 | 19 | val await_readable : Unix.file_descr -> unit 20 | (** [await_readable fd] blocks until [fd] is readable (or has an error). *) 21 | 22 | val await_writable : Unix.file_descr -> unit 23 | (** [await_writable fd] blocks until [fd] is writable (or has an error). *) 24 | 25 | (** Convert between [Unix.file_descr] and Eio objects. *) 26 | module FD : sig 27 | val peek : < unix_fd; .. > -> Unix.file_descr 28 | (** [peek x] is the Unix file descriptor underlying [x]. 29 | The caller must ensure that they do not continue to use the result after [x] is closed. *) 30 | 31 | val peek_opt : #Eio.Generic.t -> Unix.file_descr option 32 | (** [peek_opt x] is the Unix file descriptor underlying [x], if any. 33 | The caller must ensure that they do not continue to use the result after [x] is closed. *) 34 | 35 | val take : < unix_fd; .. > -> Unix.file_descr 36 | (** [take x] is like [peek], but also marks [x] as closed on success (without actually closing the FD). 37 | [x] can no longer be used after this, and the caller is responsible for closing the FD. *) 38 | 39 | val take_opt : #Eio.Generic.t -> Unix.file_descr option 40 | (** [take_opt x] is like [peek_opt], but also marks [x] as closed on success (without actually closing the FD). 41 | [x] can no longer be used after this, and the caller is responsible for closing the FD. *) 42 | 43 | val as_socket : sw:Switch.t -> close_unix:bool -> Unix.file_descr -> socket 44 | (** [as_socket ~sw ~close_unix:true fd] is an Eio flow that uses [fd]. 45 | It can be cast to e.g. {!Eio.source} for a one-way flow. 46 | The socket object will be closed when [sw] finishes. 47 | @param close_unix If [true], closing the object will also close the underlying FD. 48 | If [false], the caller is responsible for keeping [FD] open until the object is closed. *) 49 | end 50 | 51 | (** Convert between Eio.Net.Ipaddr and Unix.inet_addr. *) 52 | module Ipaddr : sig 53 | (** Internally, these are actually the same type, so these are just casts. *) 54 | 55 | val to_unix : [< `V4 | `V6] Eio.Net.Ipaddr.t -> Unix.inet_addr 56 | val of_unix : Unix.inet_addr -> Eio.Net.Ipaddr.v4v6 57 | end 58 | 59 | val sleep : float -> unit 60 | (** [sleep d] sleeps for [d] seconds, allowing other fibers to run. 61 | This is can be useful for debugging (e.g. to introduce delays to trigger a race condition) 62 | without having to plumb {!Eio.Stdenv.clock} through your code. 63 | It can also be used in programs that don't care about tracking determinism. *) 64 | 65 | val run_in_systhread : (unit -> 'a) -> 'a 66 | (** [run_in_systhread fn] runs the function [fn] in a newly created system thread (a {! Thread.t}). 67 | This allows blocking calls to be made non-blocking. *) 68 | 69 | val socketpair : 70 | sw:Switch.t -> 71 | ?domain:Unix.socket_domain -> 72 | ?ty:Unix.socket_type -> 73 | ?protocol:int -> 74 | unit -> 75 | socket * socket 76 | (** [socketpair ~sw ()] returns a connected pair of flows, such that writes to one can be read by the other. 77 | This creates OS-level resources using [socketpair(2)]. 78 | Note that, like all FDs created by Eio, they are both marked as close-on-exec by default. *) 79 | 80 | (** API for Eio backends only. *) 81 | module Private : sig 82 | type _ Eio.Generic.ty += Unix_file_descr : [`Peek | `Take] -> Unix.file_descr Eio.Generic.ty 83 | (** See {!FD}. *) 84 | 85 | type _ Effect.t += 86 | | Await_readable : Unix.file_descr -> unit Effect.t (** See {!await_readable} *) 87 | | Await_writable : Unix.file_descr -> unit Effect.t (** See {!await_writable} *) 88 | | Get_system_clock : Eio.Time.clock Effect.t (** See {!sleep} *) 89 | | Socket_of_fd : Switch.t * bool * Unix.file_descr -> 90 | socket Effect.t (** See {!FD.as_socket} *) 91 | | Socketpair : Eio.Switch.t * Unix.socket_domain * Unix.socket_type * int -> 92 | (socket * socket) Effect.t (** See {!socketpair} *) 93 | end 94 | 95 | module Ctf = Ctf_unix 96 | 97 | val getnameinfo : Eio.Net.Sockaddr.t -> (string * string) 98 | (** [getnameinfo sockaddr] returns domain name and service for [sockaddr]. *) 99 | -------------------------------------------------------------------------------- /lib_eio/stream.ml: -------------------------------------------------------------------------------- 1 | type 'a t = { 2 | mutex : Mutex.t; 3 | 4 | id : Ctf.id; 5 | 6 | capacity : int; 7 | items : 'a Queue.t; 8 | 9 | (* Readers suspended because [items] is empty. *) 10 | readers : 'a Waiters.t; 11 | 12 | (* Writers suspended because [items] is at capacity. *) 13 | writers : unit Waiters.t; 14 | } 15 | 16 | let with_mutex t f = 17 | Mutex.lock t.mutex; 18 | match f () with 19 | | x -> Mutex.unlock t.mutex; x 20 | | exception ex -> Mutex.unlock t.mutex; raise ex 21 | 22 | (* Invariants *) 23 | let _validate t = 24 | with_mutex t @@ fun () -> 25 | assert (Queue.length t.items <= t.capacity); 26 | assert (Waiters.is_empty t.readers || Queue.is_empty t.items); 27 | assert (Waiters.is_empty t.writers || Queue.length t.items = t.capacity) 28 | 29 | let create capacity = 30 | assert (capacity >= 0); 31 | let id = Ctf.mint_id () in 32 | Ctf.note_created id Ctf.Stream; 33 | { 34 | mutex = Mutex.create (); 35 | id; 36 | capacity; 37 | items = Queue.create (); 38 | readers = Waiters.create (); 39 | writers = Waiters.create (); 40 | } 41 | 42 | let add t item = 43 | Mutex.lock t.mutex; 44 | match Waiters.wake_one t.readers item with 45 | | `Ok -> Mutex.unlock t.mutex 46 | | `Queue_empty -> 47 | (* No-one is waiting for an item. Queue it. *) 48 | if Queue.length t.items < t.capacity then ( 49 | Queue.add item t.items; 50 | Mutex.unlock t.mutex 51 | ) else ( 52 | (* The queue is full. Wait for our turn first. *) 53 | Suspend.enter_unchecked @@ fun ctx enqueue -> 54 | Waiters.await_internal ~mutex:(Some t.mutex) t.writers t.id ctx (fun r -> 55 | (* This is called directly from [wake_one] and so we have the lock. 56 | We're still running in [wake_one]'s domain here. *) 57 | if Result.is_ok r then ( 58 | (* We get here immediately when called by [take], either: 59 | 1. after removing an item, so there is space, or 60 | 2. if [capacity = 0]; [take] will immediately remove the new item. *) 61 | Queue.add item t.items; 62 | ); 63 | enqueue r 64 | ) 65 | ) 66 | 67 | let take t = 68 | Mutex.lock t.mutex; 69 | match Queue.take_opt t.items with 70 | | None -> 71 | (* There aren't any items, so we probably need to wait for one. 72 | However, there's also the special case of a zero-capacity queue to deal with. 73 | [is_empty writers || capacity = 0] *) 74 | begin match Waiters.wake_one t.writers () with 75 | | `Queue_empty -> 76 | Waiters.await ~mutex:(Some t.mutex) t.readers t.id 77 | | `Ok -> 78 | (* [capacity = 0] (this is the only way we can get waiters and no items). 79 | [wake_one] has just added an item to the queue; remove it to restore 80 | the invariant before closing the mutex. *) 81 | let x = Queue.take t.items in 82 | Mutex.unlock t.mutex; 83 | x 84 | end 85 | | Some v -> 86 | (* If anyone was waiting for space, let the next one go. 87 | [is_empty writers || length items = t.capacity - 1] *) 88 | begin match Waiters.wake_one t.writers () with 89 | | `Ok (* [length items = t.capacity] again *) 90 | | `Queue_empty -> () (* [is_empty writers] *) 91 | end; 92 | Mutex.unlock t.mutex; 93 | v 94 | 95 | let take_nonblocking t = 96 | Mutex.lock t.mutex; 97 | match Queue.take_opt t.items with 98 | | None -> 99 | (* There aren't any items. 100 | However, there's also the special case of a zero-capacity queue to deal with. 101 | [is_empty writers || capacity = 0] *) 102 | begin match Waiters.wake_one t.writers () with 103 | | `Queue_empty -> Mutex.unlock t.mutex; None 104 | | `Ok -> 105 | (* [capacity = 0] (this is the only way we can get waiters and no items). 106 | [wake_one] has just added an item to the queue; remove it to restore 107 | the invariant before closing the mutex. *) 108 | let x = Queue.take t.items in 109 | Mutex.unlock t.mutex; 110 | Some x 111 | end 112 | | Some v -> 113 | (* If anyone was waiting for space, let the next one go. 114 | [is_empty writers || length items = t.capacity - 1] *) 115 | begin match Waiters.wake_one t.writers () with 116 | | `Ok (* [length items = t.capacity] again *) 117 | | `Queue_empty -> () (* [is_empty writers] *) 118 | end; 119 | Mutex.unlock t.mutex; 120 | Some v 121 | 122 | let length t = 123 | Mutex.lock t.mutex; 124 | let len = Queue.length t.items in 125 | Mutex.unlock t.mutex; 126 | len 127 | 128 | let is_empty t = (length t = 0) 129 | -------------------------------------------------------------------------------- /lib_eio_luv/eio_luv.mli: -------------------------------------------------------------------------------- 1 | (** Eio backend using libuv. 2 | 3 | You will normally not use this module directly. 4 | Instead, use {!Eio_main.run} to start an event loop and then use the API in the {!Eio} module. 5 | 6 | However, it is possible to use this module directly if you only want to support libuv. *) 7 | 8 | open Eio.Std 9 | 10 | module Low_level : sig 11 | type 'a or_error = ('a, Luv.Error.t) result 12 | 13 | exception Luv_error of Luv.Error.t 14 | 15 | val or_raise : 'a or_error -> 'a 16 | (** [or_raise (Error e)] raises [Luv_error e]. *) 17 | 18 | val await_with_cancel : 19 | request:[< `File | `Addr_info | `Name_info | `Random | `Thread_pool ] Luv.Request.t -> 20 | (Luv.Loop.t -> ('a -> unit) -> unit) -> 'a 21 | (** [await_with_cancel ~request fn] converts a function using a luv-style callback to one using effects. 22 | It sets the fiber's cancel function to cancel [request], and clears it when the operation completes. *) 23 | 24 | (** {1 Time functions} *) 25 | 26 | val sleep_until : float -> unit 27 | (** [sleep_until time] blocks until the current time is [time]. *) 28 | 29 | (** {1 DNS functions} *) 30 | 31 | val getaddrinfo : service:string -> string -> Eio.Net.Sockaddr.t list 32 | (** [getaddrinfo ~service host] returns a list of IP addresses for [host]. [host] is either a domain name or 33 | an ipaddress. *) 34 | 35 | (** {1 Low-level wrappers for Luv functions} *) 36 | 37 | module File : sig 38 | type t 39 | 40 | val is_open : t -> bool 41 | (** [is_open t] is [true] if {!close} hasn't been called yet. *) 42 | 43 | val close : t -> unit 44 | (** [close t] closes [t]. 45 | @raise Invalid_arg if [t] is already closed. *) 46 | 47 | val of_luv : ?close_unix:bool -> sw:Switch.t -> Luv.File.t -> t 48 | (** [of_luv ~sw fd] wraps [fd] as an open file descriptor. 49 | This is unsafe if [fd] is closed directly (before or after wrapping it). 50 | @param sw The FD is closed when [sw] is released, if not closed manually first. 51 | @param close_unix if [true] (the default), calling [close] also closes [fd]. *) 52 | 53 | val to_luv : t -> Luv.File.t 54 | (** [to_luv t] returns the wrapped descriptor. 55 | This allows unsafe access to the FD. 56 | @raise Invalid_arg if [t] is closed. *) 57 | 58 | val open_ : 59 | sw:Switch.t -> 60 | ?mode:Luv.File.Mode.t list -> 61 | string -> Luv.File.Open_flag.t list -> t or_error 62 | (** Wraps {!Luv.File.open_} *) 63 | 64 | val read : t -> Luv.Buffer.t list -> Unsigned.Size_t.t or_error 65 | (** Wraps {!Luv.File.read} *) 66 | 67 | val write : t -> Luv.Buffer.t list -> unit 68 | (** [write t bufs] writes all the data in [bufs] (which may take several calls to {!Luv.File.write}). *) 69 | 70 | val realpath : string -> string or_error 71 | (** Wraps {!Luv.File.realpath} *) 72 | 73 | val mkdir : mode:Luv.File.Mode.t list -> string -> unit or_error 74 | (** Wraps {!Luv.File.mkdir} *) 75 | 76 | val rmdir : string -> unit or_error 77 | (** Wraps {!Luv.File.rmdir} *) 78 | 79 | val unlink : string -> unit or_error 80 | (** Wraps {!Luv.File.unlink} *) 81 | 82 | val readdir : string -> string list or_error 83 | (** Wraps {!Luv.File.readdir}. [readdir] opens and closes the directory for reading for the user. *) 84 | end 85 | 86 | module Random : sig 87 | val fill : Luv.Buffer.t -> unit 88 | (** Wraps {!Luv.Random.random} *) 89 | end 90 | 91 | module Handle : sig 92 | type 'a t 93 | constraint 'a = [< `Poll | `Stream of [< `Pipe | `TCP | `TTY ] | `UDP ] 94 | 95 | val is_open : 'a t -> bool 96 | (** [is_open t] is [true] if {!close} hasn't been called yet. *) 97 | 98 | val close : 'a t -> unit 99 | (** [close t] closes [t]. 100 | @raise Invalid_arg if [t] is already closed. *) 101 | 102 | val to_luv : 'a t -> 'a Luv.Handle.t 103 | (** [to_luv t] returns the wrapped handle. 104 | This allows unsafe access to the handle. 105 | @raise Invalid_arg if [t] is closed. *) 106 | 107 | val of_luv : ?close_unix:bool -> sw:Switch.t -> 'a Luv.Handle.t -> 'a t 108 | (** [of_luv ~sw h] wraps [h] as an open handle. 109 | This is unsafe if [h] is closed directly (before or after wrapping it). 110 | @param sw The handle is closed when [sw] is released, if not closed manually first. 111 | @param close_unix if [true] (the default), calling [close] also closes [fd]. *) 112 | end 113 | end 114 | 115 | (** {1 Eio API} *) 116 | 117 | type has_fd = < fd : Low_level.File.t > 118 | type source = < Eio.Flow.source; Eio.Flow.close; has_fd > 119 | type sink = < Eio.Flow.sink ; Eio.Flow.close; has_fd > 120 | 121 | type stdenv = < 122 | stdin : source; 123 | stdout : sink; 124 | stderr : sink; 125 | net : Eio.Net.t; 126 | domain_mgr : Eio.Domain_manager.t; 127 | clock : Eio.Time.clock; 128 | fs : Eio.Fs.dir Eio.Path.t; 129 | cwd : Eio.Fs.dir Eio.Path.t; 130 | secure_random : Eio.Flow.source; 131 | debug : Eio.Debug.t; 132 | > 133 | 134 | val get_fd : -> Low_level.File.t 135 | val get_fd_opt : #Eio.Generic.t -> Low_level.File.t option 136 | 137 | (** {1 Main Loop} *) 138 | 139 | val run : (stdenv -> 'a) -> 'a 140 | -------------------------------------------------------------------------------- /lib_eio/utils/lf_queue.ml: -------------------------------------------------------------------------------- 1 | (* A lock-free multi-producer, single-consumer, thread-safe queue without support for cancellation. 2 | This makes a good data structure for a scheduler's run queue. 3 | 4 | See: "Implementing lock-free queues" 5 | https://people.cs.pitt.edu/~jacklange/teaching/cs2510-f12/papers/implementing_lock_free.pdf 6 | 7 | It is simplified slightly because we don't need multiple consumers. 8 | Therefore [head] is not atomic. *) 9 | 10 | exception Closed 11 | 12 | module Node : sig 13 | type 'a t = { 14 | next : 'a opt Atomic.t; 15 | mutable value : 'a; 16 | } 17 | and +'a opt 18 | 19 | val make : next:'a opt -> 'a -> 'a t 20 | 21 | val none : 'a opt 22 | (** [t.next = none] means that [t] is currently the last node. *) 23 | 24 | val closed : 'a opt 25 | (** [t.next = closed] means that [t] will always be the last node. *) 26 | 27 | val some : 'a t -> 'a opt 28 | val fold : 'a opt -> none:(unit -> 'b) -> some:('a t -> 'b) -> 'b 29 | end = struct 30 | (* https://github.com/ocaml/RFCs/pull/14 should remove the need for magic here *) 31 | 32 | type +'a opt (* special | 'a t *) 33 | 34 | type 'a t = { 35 | next : 'a opt Atomic.t; 36 | mutable value : 'a; 37 | } 38 | 39 | type special = 40 | | Nothing 41 | | Closed 42 | 43 | let none : 'a. 'a opt = Obj.magic Nothing 44 | let closed : 'a. 'a opt = Obj.magic Closed 45 | let some (t : 'a t) : 'a opt = Obj.magic t 46 | 47 | let fold (opt : 'a opt) ~none:n ~some = 48 | if opt == none then n () 49 | else if opt == closed then raise Closed 50 | else some (Obj.magic opt : 'a t) 51 | 52 | let make ~next value = { value; next = Atomic.make next } 53 | end 54 | 55 | type 'a t = { 56 | tail : 'a Node.t Atomic.t; 57 | mutable head : 'a Node.t; 58 | } 59 | (* [head] is the last node dequeued (or a dummy node, initially). 60 | [head.next] gives the real first node, if not [Node.none]. 61 | If [tail.next] is [none] then it is the last node in the queue. 62 | Otherwise, [tail.next] is a node that is closer to the tail. *) 63 | 64 | let push t x = 65 | let node = Node.(make ~next:none) x in 66 | let rec aux () = 67 | let p = Atomic.get t.tail in 68 | (* While [p.next == none], [p] is the last node in the queue. *) 69 | if Atomic.compare_and_set p.next Node.none (Node.some node) then ( 70 | (* [node] has now been added to the queue (and possibly even consumed). 71 | Update [tail], unless someone else already did it for us. *) 72 | ignore (Atomic.compare_and_set t.tail p node : bool) 73 | ) else ( 74 | (* Someone else added a different node first ([p.next] is not [none]). 75 | Make [t.tail] more up-to-date, if it hasn't already changed, and try again. *) 76 | Node.fold (Atomic.get p.next) 77 | ~none:(fun () -> assert false) 78 | ~some:(fun p_next -> 79 | ignore (Atomic.compare_and_set t.tail p p_next : bool); 80 | aux () 81 | ) 82 | ) 83 | in 84 | aux () 85 | 86 | let rec push_head t x = 87 | let p = t.head in 88 | let next = Atomic.get p.next in 89 | if next == Node.closed then raise Closed; 90 | let node = Node.make ~next x in 91 | if Atomic.compare_and_set p.next next (Node.some node) then ( 92 | (* We don't want to let [tail] get too far behind, so if the queue was empty, move it to the new node. *) 93 | if next == Node.none then ( 94 | ignore (Atomic.compare_and_set t.tail p node : bool); 95 | ) else ( 96 | (* If the queue wasn't empty, there's nothing to do. 97 | Either tail isn't at head or there is some [push] thread working to update it. 98 | Either [push] will update it directly to the new tail, or will update it to [node] 99 | and then retry. Either way, it ends up at the real tail. *) 100 | ) 101 | ) else ( 102 | (* Someone else changed it first. This can only happen if the queue was empty. *) 103 | assert (next == Node.none); 104 | push_head t x 105 | ) 106 | 107 | let rec close (t:'a t) = 108 | (* Mark the tail node as final. *) 109 | let p = Atomic.get t.tail in 110 | if not (Atomic.compare_and_set p.next Node.none Node.closed) then ( 111 | (* CAS failed because [p] is no longer the tail (or is already closed). *) 112 | Node.fold (Atomic.get p.next) 113 | ~none:(fun () -> assert false) (* Can't switch from another state to [none] *) 114 | ~some:(fun p_next -> 115 | (* Make [tail] more up-to-date if it hasn't changed already *) 116 | ignore (Atomic.compare_and_set t.tail p p_next : bool); 117 | (* Retry *) 118 | close t 119 | ) 120 | ) 121 | 122 | let pop t = 123 | let p = t.head in 124 | (* [p] is the previously-popped item. *) 125 | let node = Atomic.get p.next in 126 | Node.fold node 127 | ~none:(fun () -> None) 128 | ~some:(fun node -> 129 | t.head <- node; 130 | let v = node.value in 131 | node.value <- Obj.magic (); (* So it can be GC'd *) 132 | Some v 133 | ) 134 | 135 | let is_empty t = 136 | Node.fold (Atomic.get t.head.next) 137 | ~none:(fun () -> true) 138 | ~some:(fun _ -> false) 139 | 140 | let create () = 141 | let dummy = { Node.value = Obj.magic (); next = Atomic.make Node.none } in 142 | { tail = Atomic.make dummy; head = dummy } 143 | -------------------------------------------------------------------------------- /tests/sync.md: -------------------------------------------------------------------------------- 1 | # Setting up the environment 2 | 3 | ```ocaml 4 | # #require "eio_main";; 5 | ``` 6 | 7 | ```ocaml 8 | open Eio.Std 9 | 10 | module Ctf = Eio.Private.Ctf 11 | 12 | let pp_promise pp f x = 13 | match Promise.peek x with 14 | | None -> Fmt.string f "unresolved" 15 | | Some Error (Failure msg) -> Fmt.pf f "broken:%s" msg 16 | | Some Error ex -> Fmt.pf f "broken:%a" Fmt.exn ex 17 | | Some Ok x -> Fmt.pf f "fulfilled:%a" pp x 18 | ``` 19 | 20 | # Test cases 21 | 22 | Create a promise, fork a thread waiting for it, then fulfull it: 23 | ```ocaml 24 | # let () = 25 | Eio_main.run @@ fun _stdenv -> 26 | Switch.run @@ fun sw -> 27 | let p, r = Promise.create () in 28 | traceln "Initial state: %a" (pp_promise Fmt.string) p; 29 | let thread = Fiber.fork_promise ~sw (fun () -> Promise.await_exn p) in 30 | Promise.resolve_ok r "ok"; 31 | traceln "After being fulfilled: %a" (pp_promise Fmt.string) p; 32 | traceln "Thread before yield: %a" (pp_promise Fmt.string) thread; 33 | Fiber.yield (); 34 | traceln "Thread after yield: %a" (pp_promise Fmt.string) thread; 35 | traceln "Final result: %s" (Promise.await_exn thread);; 36 | +Initial state: unresolved 37 | +After being fulfilled: fulfilled:ok 38 | +Thread before yield: unresolved 39 | +Thread after yield: fulfilled:ok 40 | +Final result: ok 41 | ``` 42 | 43 | Create a promise, fork a thread waiting for it, then break it: 44 | ```ocaml 45 | # let () = 46 | Eio_main.run @@ fun _stdenv -> 47 | Switch.run @@ fun sw -> 48 | let p, r = Promise.create () in 49 | traceln "Initial state: %a" (pp_promise Fmt.string) p; 50 | let thread = Fiber.fork_promise ~sw (fun () -> Promise.await_exn p) in 51 | Promise.resolve_error r (Failure "test"); 52 | traceln "After being broken: %a" (pp_promise Fmt.string) p; 53 | traceln "Thread before yield: %a" (pp_promise Fmt.string) thread; 54 | Fiber.yield (); 55 | traceln "Thread after yield: %a" (pp_promise Fmt.string) thread; 56 | match Promise.await_exn thread with 57 | | x -> failwith x 58 | | exception (Failure msg) -> traceln "Final result exception: %s" msg;; 59 | +Initial state: unresolved 60 | +After being broken: broken:test 61 | +Thread before yield: unresolved 62 | +Thread after yield: broken:test 63 | +Final result exception: test 64 | ``` 65 | 66 | Some simple tests of `fork`: 67 | ```ocaml 68 | # let () = 69 | Eio_main.run @@ fun _stdenv -> 70 | let i = ref 0 in 71 | Switch.run (fun sw -> 72 | Fiber.fork ~sw (fun () -> incr i); 73 | ); 74 | traceln "Forked code ran; i is now %d" !i; 75 | let p1, r1 = Promise.create () in 76 | try 77 | Switch.run (fun sw -> 78 | Fiber.fork ~sw (fun () -> Promise.await p1; incr i; raise Exit); 79 | traceln "Forked code waiting; i is still %d" !i; 80 | Promise.resolve r1 () 81 | ); 82 | assert false 83 | with Exit -> 84 | traceln "Forked code ran; i is now %d" !i;; 85 | +Forked code ran; i is now 1 86 | +Forked code waiting; i is still 1 87 | +Forked code ran; i is now 2 88 | ``` 89 | 90 | Basic semaphore tests: 91 | ```ocaml 92 | # let () = 93 | let module Semaphore = Eio.Semaphore in 94 | Eio_main.run @@ fun _stdenv -> 95 | Switch.run @@ fun sw -> 96 | let running = ref 0 in 97 | let sem = Semaphore.make 2 in 98 | let fork = Fiber.fork_promise ~sw in 99 | let a = fork (fun () -> Ctf.label "a"; Semaphore.acquire sem; incr running) in 100 | let b = fork (fun () -> Ctf.label "b"; Semaphore.acquire sem; incr running) in 101 | let c = fork (fun () -> Ctf.label "c"; Semaphore.acquire sem; incr running) in 102 | let d = fork (fun () -> Ctf.label "d"; Semaphore.acquire sem; incr running) in 103 | traceln "Semaphore means that only %d threads are running" !running; 104 | Promise.await_exn a; 105 | Promise.await_exn b; 106 | (* a finishes and c starts *) 107 | decr running; 108 | Semaphore.release sem; 109 | traceln "One finished; now %d is running " !running; 110 | Fiber.yield (); 111 | traceln "Yield allows C to start; now %d are running " !running; 112 | Promise.await_exn c; 113 | (* b finishes and d starts *) 114 | decr running; 115 | Semaphore.release sem; 116 | Promise.await_exn d; 117 | decr running; 118 | Semaphore.release sem; 119 | decr running; 120 | Semaphore.release sem;; 121 | +Semaphore means that only 2 threads are running 122 | +One finished; now 1 is running 123 | +Yield allows C to start; now 2 are running 124 | ``` 125 | 126 | Releasing a semaphore when no-one is waiting for it: 127 | ```ocaml 128 | # let () = 129 | let module Semaphore = Eio.Semaphore in 130 | Eio_main.run @@ fun _stdenv -> 131 | Switch.run @@ fun sw -> 132 | let sem = Semaphore.make 0 in 133 | Semaphore.release sem; (* Release with free-counter *) 134 | traceln "Initial config: %d" (Semaphore.get_value sem); 135 | Fiber.fork ~sw (fun () -> Ctf.label "a"; Semaphore.acquire sem); 136 | Fiber.fork ~sw (fun () -> Ctf.label "b"; Semaphore.acquire sem); 137 | traceln "A running: %d" (Semaphore.get_value sem); 138 | Semaphore.release sem; (* Release with a non-empty wait-queue *) 139 | traceln "Now b running: %d" (Semaphore.get_value sem); 140 | Semaphore.release sem; (* Release with an empty wait-queue *) 141 | traceln "Finished: %d" (Semaphore.get_value sem);; 142 | +Initial config: 1 143 | +A running: 0 144 | +Now b running: 0 145 | +Finished: 1 146 | ``` 147 | -------------------------------------------------------------------------------- /tests/domains.md: -------------------------------------------------------------------------------- 1 | # Setting up the environment 2 | 3 | ```ocaml 4 | # #require "eio_main";; 5 | ``` 6 | 7 | ```ocaml 8 | open Eio.Std 9 | 10 | let run (fn : Eio.Domain_manager.t -> unit) = 11 | Eio_main.run @@ fun env -> 12 | fn (Eio.Stdenv.domain_mgr env) 13 | ``` 14 | 15 | # Test cases 16 | 17 | Spawning a second domain: 18 | 19 | ```ocaml 20 | # run @@ fun mgr -> 21 | let response = Eio.Domain_manager.run mgr (fun () -> "Hello from new domain") in 22 | traceln "Got %S from spawned domain" response;; 23 | +Got "Hello from new domain" from spawned domain 24 | - : unit = () 25 | ``` 26 | 27 | The domain raises an exception: 28 | 29 | ```ocaml 30 | # run @@ fun mgr -> 31 | Eio.Domain_manager.run mgr (fun () -> failwith "Exception from new domain");; 32 | Exception: Failure "Exception from new domain". 33 | ``` 34 | 35 | We can still run other fibers in the main domain while waiting. 36 | Here, we use a mutex to check that the parent domain really did run while waiting for the child domain. 37 | 38 | ```ocaml 39 | # run @@ fun mgr -> 40 | let mutex = Stdlib.Mutex.create () in 41 | Mutex.lock mutex; 42 | Fiber.both 43 | (fun () -> 44 | traceln "Spawning new domain..."; 45 | let response = Eio.Domain_manager.run mgr (fun () -> 46 | Mutex.lock mutex; 47 | Mutex.unlock mutex; 48 | "Hello from new domain" 49 | ) in 50 | traceln "Got %S from spawned domain" response 51 | ) 52 | (fun () -> 53 | traceln "Other fibers can still run"; 54 | Mutex.unlock mutex 55 | );; 56 | +Spawning new domain... 57 | +Other fibers can still run 58 | +Got "Hello from new domain" from spawned domain 59 | - : unit = () 60 | ``` 61 | 62 | Cancelling another domain: 63 | 64 | ```ocaml 65 | # run @@ fun mgr -> 66 | Fiber.both 67 | (fun () -> 68 | try 69 | Eio.Domain_manager.run mgr (fun () -> 70 | try Fiber.await_cancel () 71 | with ex -> traceln "Spawned domain got %a" Fmt.exn ex; raise ex 72 | ) 73 | with ex -> traceln "Spawning fiber got %a" Fmt.exn ex; raise ex 74 | ) 75 | (fun () -> failwith "Simulated error");; 76 | +Spawned domain got Cancelled: Failure("Simulated error") 77 | +Spawning fiber got Cancelled: Failure("Simulated error") 78 | Exception: Failure "Simulated error". 79 | ``` 80 | 81 | Spawning when already cancelled - no new domain is started: 82 | 83 | ```ocaml 84 | # run @@ fun mgr -> 85 | Switch.run @@ fun sw -> 86 | Switch.fail sw (Failure "Simulated error"); 87 | Eio.Domain_manager.run mgr (fun () -> traceln "Domain spawned - shouldn't happen!");; 88 | Exception: Failure "Simulated error". 89 | ``` 90 | 91 | Using a cancellation context across domains is not permitted: 92 | 93 | ```ocaml 94 | # run @@ fun mgr -> 95 | Switch.run @@ fun sw -> 96 | let p, r = Promise.create () in 97 | Fiber.both 98 | (fun () -> 99 | Eio.Domain_manager.run mgr @@ fun () -> 100 | Eio.Cancel.sub @@ fun cc -> 101 | Promise.resolve r cc; 102 | Fiber.await_cancel () 103 | ) 104 | (fun () -> 105 | let cc = Promise.await p in 106 | Eio.Cancel.cancel cc Exit 107 | );; 108 | Exception: 109 | Invalid_argument "Cancellation context accessed from wrong domain!". 110 | ``` 111 | 112 | Likewise, switches can't be shared: 113 | 114 | ```ocaml 115 | # run @@ fun mgr -> 116 | Switch.run @@ fun sw -> 117 | let p, r = Promise.create () in 118 | Fiber.both 119 | (fun () -> 120 | Eio.Domain_manager.run mgr @@ fun () -> 121 | Switch.run @@ fun sw -> 122 | Promise.resolve r sw; 123 | Fiber.await_cancel () 124 | ) 125 | (fun () -> 126 | let sw = Promise.await p in 127 | Switch.fail sw Exit 128 | );; 129 | Exception: Invalid_argument "Switch accessed from wrong domain!". 130 | ``` 131 | 132 | Can't register a release handler across domains: 133 | 134 | ```ocaml 135 | # run @@ fun mgr -> 136 | Switch.run @@ fun sw -> 137 | let p, r = Promise.create () in 138 | Fiber.both 139 | (fun () -> 140 | Eio.Domain_manager.run mgr @@ fun () -> 141 | Switch.run @@ fun sw -> 142 | Promise.resolve r sw; 143 | Fiber.await_cancel () 144 | ) 145 | (fun () -> 146 | let sw = Promise.await p in 147 | Switch.on_release sw ignore 148 | );; 149 | Exception: Invalid_argument "Switch accessed from wrong domain!". 150 | ``` 151 | 152 | Can't release a release handler across domains: 153 | 154 | ```ocaml 155 | # run @@ fun mgr -> 156 | Switch.run @@ fun sw -> 157 | let p, r = Promise.create () in 158 | Fiber.both 159 | (fun () -> 160 | Eio.Domain_manager.run mgr @@ fun () -> 161 | Switch.run @@ fun sw -> 162 | let hook = Switch.on_release_cancellable sw ignore in 163 | Promise.resolve r hook; 164 | Fiber.await_cancel () 165 | ) 166 | (fun () -> 167 | let hook = Promise.await p in 168 | Switch.remove_hook hook 169 | );; 170 | Exception: Invalid_argument "Switch hook removed from wrong domain!". 171 | ``` 172 | 173 | Can't fork into another domain: 174 | 175 | ```ocaml 176 | # run @@ fun mgr -> 177 | Switch.run @@ fun sw -> 178 | let p, r = Promise.create () in 179 | Fiber.both 180 | (fun () -> 181 | Eio.Domain_manager.run mgr @@ fun () -> 182 | Switch.run @@ fun sw -> 183 | Promise.resolve r sw; 184 | Fiber.await_cancel () 185 | ) 186 | (fun () -> 187 | let sw = Promise.await p in 188 | Fiber.fork ~sw ignore; 189 | );; 190 | Exception: Invalid_argument "Switch accessed from wrong domain!". 191 | ``` 192 | 193 | # Fiber-local storage 194 | 195 | Fiber-local bindings are not propagated when spawning fibers in other 196 | domains (as the values may not be thread-safe): 197 | 198 | ```ocaml 199 | # run @@ fun mgr -> 200 | let key = Fiber.create_key () in 201 | Fiber.with_binding key 123 @@ fun () -> 202 | Eio.Domain_manager.run mgr @@ fun () -> 203 | traceln "Key => %a" Fmt.(option ~none:(const string "") int) (Fiber.get key);; 204 | +Key => 205 | - : unit = () 206 | ``` 207 | -------------------------------------------------------------------------------- /lib_eio/core/switch.ml: -------------------------------------------------------------------------------- 1 | type t = { 2 | id : Ctf.id; 3 | mutable fibers : int; (* Total, including daemon_fibers and the main function *) 4 | mutable daemon_fibers : int; 5 | mutable exs : (exn * Printexc.raw_backtrace) option; 6 | on_release : (unit -> unit) Lwt_dllist.t; 7 | waiter : unit Waiters.t; (* The main [top]/[sub] function may wait here for fibers to finish. *) 8 | cancel : Cancel.t; 9 | } 10 | 11 | type hook = 12 | | Null 13 | | Hook : Domain.id * 'a Lwt_dllist.node -> hook 14 | 15 | let null_hook = Null 16 | 17 | let remove_hook = function 18 | | Null -> () 19 | | Hook (id, n) -> 20 | if Domain.self () <> id then invalid_arg "Switch hook removed from wrong domain!"; 21 | Lwt_dllist.remove n 22 | 23 | let dump f t = 24 | Fmt.pf f "@[Switch %d (%d extra fibers):@,%a@]" 25 | (t.id :> int) 26 | t.fibers 27 | Cancel.dump t.cancel 28 | 29 | let is_finished t = Cancel.is_finished t.cancel 30 | 31 | (* Check switch belongs to this domain (and isn't finished). It's OK if it's cancelling. *) 32 | let check_our_domain t = 33 | if is_finished t then invalid_arg "Switch finished!"; 34 | if Domain.self () <> t.cancel.domain then invalid_arg "Switch accessed from wrong domain!" 35 | 36 | (* Check isn't cancelled (or finished). *) 37 | let check t = 38 | if is_finished t then invalid_arg "Switch finished!"; 39 | Cancel.check t.cancel 40 | 41 | let get_error t = 42 | Cancel.get_error t.cancel 43 | 44 | let combine_exn ex = function 45 | | None -> ex 46 | | Some ex1 -> Exn.combine ex1 ex 47 | 48 | (* Note: raises if [t] is finished or called from wrong domain. *) 49 | let fail ?(bt=Printexc.get_raw_backtrace ()) t ex = 50 | check_our_domain t; 51 | if t.exs = None then 52 | Ctf.note_resolved t.id ~ex:(Some ex); 53 | t.exs <- Some (combine_exn (ex, bt) t.exs); 54 | try 55 | Cancel.cancel t.cancel ex 56 | with Exn.Cancel_hook_failed _ as ex -> 57 | let bt = Printexc.get_raw_backtrace () in 58 | t.exs <- Some (combine_exn (ex, bt) t.exs) 59 | 60 | let inc_fibers t = 61 | check t; 62 | t.fibers <- t.fibers + 1 63 | 64 | let dec_fibers t = 65 | t.fibers <- t.fibers - 1; 66 | if t.daemon_fibers > 0 && t.fibers = t.daemon_fibers then 67 | Cancel.cancel t.cancel Exit; 68 | if t.fibers = 0 then 69 | Waiters.wake_all t.waiter () 70 | 71 | let with_op t fn = 72 | inc_fibers t; 73 | Fun.protect fn 74 | ~finally:(fun () -> dec_fibers t) 75 | 76 | let with_daemon t fn = 77 | inc_fibers t; 78 | t.daemon_fibers <- t.daemon_fibers + 1; 79 | Fun.protect fn 80 | ~finally:(fun () -> 81 | t.daemon_fibers <- t.daemon_fibers - 1; 82 | dec_fibers t 83 | ) 84 | 85 | let or_raise = function 86 | | Ok x -> x 87 | | Error ex -> raise ex 88 | 89 | let rec await_idle t = 90 | (* Wait for fibers to finish: *) 91 | while t.fibers > 0 do 92 | Ctf.note_try_read t.id; 93 | Waiters.await ~mutex:None t.waiter t.id 94 | done; 95 | (* Call on_release handlers: *) 96 | let queue = Lwt_dllist.create () in 97 | Lwt_dllist.transfer_l t.on_release queue; 98 | let rec release () = 99 | match Lwt_dllist.take_opt_r queue with 100 | | None when t.fibers = 0 && Lwt_dllist.is_empty t.on_release -> () 101 | | None -> await_idle t 102 | | Some fn -> 103 | begin 104 | try fn () with 105 | | ex -> fail t ex 106 | end; 107 | release () 108 | in 109 | release () 110 | 111 | let await_idle t = Cancel.protect (fun _ -> await_idle t) 112 | 113 | let maybe_raise_exs t = 114 | match t.exs with 115 | | None -> () 116 | | Some (ex, bt) -> Printexc.raise_with_backtrace ex bt 117 | 118 | let create cancel = 119 | let id = Ctf.mint_id () in 120 | Ctf.note_created id Ctf.Switch; 121 | { 122 | id; 123 | fibers = 1; (* The main function counts as a fiber *) 124 | daemon_fibers = 0; 125 | exs = None; 126 | waiter = Waiters.create (); 127 | on_release = Lwt_dllist.create (); 128 | cancel; 129 | } 130 | 131 | let run_internal t fn = 132 | match fn t with 133 | | v -> 134 | dec_fibers t; 135 | await_idle t; 136 | Ctf.note_read t.id; 137 | maybe_raise_exs t; (* Check for failure while finishing *) 138 | (* Success. *) 139 | v 140 | | exception ex -> 141 | (* Main function failed. 142 | Turn the switch off to cancel any running fibers, if it's not off already. *) 143 | dec_fibers t; 144 | fail t ex; 145 | await_idle t; 146 | Ctf.note_read t.id; 147 | maybe_raise_exs t; 148 | assert false 149 | 150 | let run fn = Cancel.sub (fun cc -> run_internal (create cc) fn) 151 | 152 | let run_protected fn = 153 | let ctx = Effect.perform Cancel.Get_context in 154 | Cancel.with_cc ~ctx ~parent:ctx.cancel_context ~protected:true @@ fun cancel -> 155 | run_internal (create cancel) fn 156 | 157 | (* Run [fn ()] in [t]'s cancellation context. 158 | This prevents [t] from finishing until [fn] is done, 159 | and means that cancelling [t] will cancel [fn]. *) 160 | let run_in t fn = 161 | with_op t @@ fun () -> 162 | let ctx = Effect.perform Cancel.Get_context in 163 | let old_cc = ctx.cancel_context in 164 | Cancel.move_fiber_to t.cancel ctx; 165 | match fn () with 166 | | () -> Cancel.move_fiber_to old_cc ctx; 167 | | exception ex -> Cancel.move_fiber_to old_cc ctx; raise ex 168 | 169 | let on_release_full t fn = 170 | if Domain.self () = t.cancel.domain then ( 171 | match t.cancel.state with 172 | | On | Cancelling _ -> Lwt_dllist.add_r fn t.on_release 173 | | Finished -> 174 | match Cancel.protect fn with 175 | | () -> invalid_arg "Switch finished!" 176 | | exception ex -> raise (Exn.Multiple [ex; Invalid_argument "Switch finished!"]) 177 | ) else ( 178 | match Cancel.protect fn with 179 | | () -> invalid_arg "Switch accessed from wrong domain!" 180 | | exception ex -> raise (Exn.Multiple [ex; Invalid_argument "Switch accessed from wrong domain!"]) 181 | ) 182 | 183 | let on_release t fn = 184 | ignore (on_release_full t fn : _ Lwt_dllist.node) 185 | 186 | let on_release_cancellable t fn = 187 | Hook (t.cancel.domain, on_release_full t fn) 188 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | ## v0.5 2 | 3 | New features: 4 | 5 | - Add `Eio.Condition` (@TheLortex @talex5 #277). 6 | Allows a fiber to wait for some condition to become true. 7 | 8 | - Add `Eio.Net.getaddrinfo` and `getnameinfo` (@bikallem @talex5 #278 #288 #291). 9 | Convert between host names and addresses. 10 | 11 | - Add `Eio.Debug` (@talex5 #276). 12 | Currently, this allows overriding the `traceln` function. 13 | 14 | - `Buf_write.create`: make switch optional (@talex5 #283). 15 | This makes things easier for people porting code from Faraday. 16 | 17 | Bug fixes: 18 | 19 | - Allow sharing of libuv poll handles (@patricoferris @talex5 #279). 20 | Luv doesn't allow two callers to watch the same file handle, so we need to handle that in Eio. 21 | 22 | Other changes: 23 | 24 | - Upgrade to uring 0.4 (@talex5 #290). 25 | 26 | - Mention `Mutex`, `Semaphore` and `Condition` in the README (@talex5 #281). 27 | 28 | ## v0.4 29 | 30 | Note: Eio 0.4 drops compatibility with OCaml 4.12+domains. Use OCaml 5.0.0~alpha1 instead. 31 | 32 | API changes: 33 | 34 | - `Eio.Dir` has gone. Use `Eio.Path` instead (@talex5 #266 #270). 35 | 36 | - `Eio_unix.FD.{take,peek}` were renamed to `take_opt`/`peek_opt` to make way for non-optional versions. 37 | 38 | New features: 39 | 40 | - Fiber-local storage (@SquidDev #256). 41 | Attach key/value bindings to fibers. These are inherited across forks. 42 | 43 | - `Eio.Path.{unlink,rmdir,rename}` (@talex5 #264 #265). 44 | 45 | - `Eio_main.run` can now return a value (@talex5 #263). 46 | This is useful for e.g. cmdliner. 47 | 48 | - `Eio_unix.socketpair` (@talex5 #260). 49 | 50 | - `Fiber.fork_daemon` (@talex5 #252). 51 | Create a helper fiber that does not prevent the switch from exiting. 52 | 53 | - Add `Fiber.{iter,map,filter,fiter_map}` (@talex5 #248 #250). 54 | These are concurrent versions of the corresponding operations in `List`. 55 | 56 | Bug fixes: 57 | 58 | - Fix scheduling fairness in luv backend (@talex5 #269). 59 | 60 | - Implement remaining shutdown commands for luv (@talex5 #268). 61 | 62 | - Fix IPv6 support with uring backend (@haesbaert #261 #262). 63 | 64 | - Use `Eio.Net.Connection_reset` exception in more places (@talex5 #257). 65 | 66 | - Report use of closed FDs better (@talex5 #255). 67 | Using a closed FD could previously cause the whole event loop to exit. 68 | 69 | - Some fixes for cancellation (@talex5 #254). 70 | 71 | - Ensure `Buf_write` still flushes if an exception is raised (@talex5 #246). 72 | 73 | - Do not allow close on `accept_fork` socket (@talex5 #245). 74 | 75 | Documentation: 76 | 77 | - Document integrations with Unix, Lwt and Async (@talex5 #247). 78 | 79 | - Add a Dockerfile for easy testing (@talex5 #224). 80 | 81 | ## v0.3 82 | 83 | API changes: 84 | 85 | - `Net.accept_sub` is deprecated in favour of `accept_fork` (@talex5 #240). 86 | `Fiber.fork_on_accept`, which it used internally, has been removed. 87 | 88 | - Allow short writes in `Read_source_buffer` (@talex5 #239). 89 | The reader is no longer required to consume all the data in one go. 90 | Also, add `Linux_eio.Low_level.writev_single` to expose this behaviour directly. 91 | 92 | - `Eio.Unix_perm` is now `Eio.Dir.Unix_perm`. 93 | 94 | New features: 95 | 96 | - Add `Eio.Mutex` (@TheLortex @talex5 #223). 97 | 98 | - Add `Eio.Buf_write` (@talex5 #235). 99 | This is a buffered writer for Eio sinks, based on Faraday. 100 | 101 | - Add `Eio_mock` library for testing (@talex5 #228). 102 | At the moment it has mock flows and networks. 103 | 104 | - Add `Eio_mock.Backend` (@talex5 #237 #238). 105 | Allows running tests without needing a dependency on eio_main. 106 | Also, as it is single-threaded, it can detect deadlocks in test code instead of just hanging. 107 | 108 | - Add `Buf_read.{of_buffer, of_string, parse_string{,_exn}, return}` (@talex5 #225). 109 | 110 | - Add `<*>` combinator to `Buf_read.Syntax` (@talex5 #227). 111 | 112 | - Add `Eio.Dir.read_dir` (@patricoferris @talex5 #207 #218 #219) 113 | 114 | Performance: 115 | 116 | - Add `Buf_read` benchmark and optimise it a bit (@talex5 #230). 117 | 118 | - Inline `Buf_read.consume` to improve performance (@talex5 #232). 119 | 120 | Bug fixes / minor changes: 121 | 122 | - Allow IO to happen even if a fiber keeps yielding (@TheLortex @talex5 #213). 123 | 124 | - Fallback for `traceln` without an effect handler (@talex5 #226). 125 | `traceln` now works outside of an event loop too. 126 | 127 | - Check for cancellation when creating a non-protected child context (@talex5 #222). 128 | 129 | - eio_linux: handle EINTR when calling `getrandom` (@bikallem #212). 130 | 131 | - Update to cmdliner.1.1.0 (@talex5 #190). 132 | 133 | ## v0.2 134 | 135 | - Add support for UDP (@patricoferris #171). 136 | 137 | - Rename Fibre to Fiber (@talex5 #195). This is to match the compiler's spelling. 138 | 139 | - Switch to luv backend if uring can't be used (@talex5 #203). 140 | Useful on Windows with WSL, and also in Docker containers on older systems. 141 | 142 | - Eio_linux: cope with lack of fixed chunks (@talex5 #200). 143 | - If we run out of fixed memory, just use regular memory instead of waiting (which might deadlock). 144 | - If we try to allocate a fixed buffer and fail, we now just log a warning and continue without one. 145 | 146 | - Add support for FD passing with Eio_linux (@talex5 #199). 147 | 148 | - Add `Eio_unix.FD.as_socket` (@talex5 #193). 149 | Useful for working with existing libraries that provide a `Unix.file_descr`, or for receiving FDs from elsewhere (e.g. socket activation). 150 | Also, the `Luv.{File,Handle}.of_luv` functions now allow controlling whether to close the wrapped FD. 151 | 152 | - Add `Eio_unix.sleep` (@talex5 #188). Based on feedback that some people don't want to treat time as a capability. Possibly also useful for debugging race conditions. 153 | 154 | - Tidy up forking API (@talex5 #192). Moves some common code out the the individual backends. 155 | 156 | - Improve documentation (@talex5 #197 #194 #186 #185). In particular, explain more low-level details about how cancellation works. 157 | 158 | - Add an example `Eio_null` backend (@talex5 #189). This supports creating fibers, promises and cancellation, but provides no IO operations. 159 | 160 | - `Effect.eff` is now `Effect.t` in OCaml trunk (@talex5 #201). 161 | 162 | ## v0.1 163 | 164 | - Initial release. 165 | -------------------------------------------------------------------------------- /tests/mutex.md: -------------------------------------------------------------------------------- 1 | # Setting up the environment 2 | 3 | ```ocaml 4 | # #require "eio_main";; 5 | ``` 6 | 7 | ```ocaml 8 | open Eio.Std 9 | 10 | module M = Eio.Mutex 11 | 12 | let run fn = 13 | Eio_main.run @@ fun _ -> 14 | fn () 15 | 16 | let lock t = 17 | traceln "Locking"; 18 | M.lock t; 19 | traceln "Locked" 20 | 21 | let unlock t = 22 | traceln "Unlocking"; 23 | M.unlock t; 24 | traceln "Unlocked" 25 | ``` 26 | 27 | # Test cases 28 | 29 | Simple case 30 | 31 | ```ocaml 32 | # run @@ fun () -> 33 | let t = M.create () in 34 | lock t; 35 | unlock t; 36 | lock t; 37 | unlock t;; 38 | +Locking 39 | +Locked 40 | +Unlocking 41 | +Unlocked 42 | +Locking 43 | +Locked 44 | +Unlocking 45 | +Unlocked 46 | - : unit = () 47 | ``` 48 | 49 | Concurrent access to the mutex 50 | 51 | 52 | ```ocaml 53 | # run @@ fun () -> 54 | let t = M.create () in 55 | let fn () = 56 | lock t; 57 | Eio.Fiber.yield (); 58 | unlock t 59 | in 60 | List.init 4 (fun _ -> fn) 61 | |> Fiber.all;; 62 | +Locking 63 | +Locked 64 | +Locking 65 | +Locking 66 | +Locking 67 | +Unlocking 68 | +Unlocked 69 | +Locked 70 | +Unlocking 71 | +Unlocked 72 | +Locked 73 | +Unlocking 74 | +Unlocked 75 | +Locked 76 | +Unlocking 77 | +Unlocked 78 | - : unit = () 79 | ``` 80 | 81 | Double unlock raises an exception 82 | 83 | ```ocaml 84 | # run @@ fun () -> 85 | let t = M.create () in 86 | M.lock t; 87 | M.unlock t; 88 | begin 89 | try M.unlock t 90 | with Sys_error msg -> traceln "Caught: %s" msg 91 | end; 92 | traceln "Trying to use lock after error..."; 93 | M.lock t;; 94 | +Caught: Eio.Mutex.unlock: already unlocked! 95 | +Trying to use lock after error... 96 | Exception: 97 | Eio__Eio_mutex.Poisoned (Sys_error "Eio.Mutex.unlock: already unlocked!"). 98 | ``` 99 | 100 | ## Read-write access 101 | 102 | Successful use; only one critical section is active at once: 103 | 104 | ```ocaml 105 | # run @@ fun () -> 106 | let t = M.create () in 107 | let fn () = 108 | traceln "Entered critical section"; 109 | Fiber.yield (); 110 | traceln "Leaving critical section" 111 | in 112 | Fiber.both 113 | (fun () -> M.use_rw ~protect:true t fn) 114 | (fun () -> M.use_rw ~protect:true t fn);; 115 | +Entered critical section 116 | +Leaving critical section 117 | +Entered critical section 118 | +Leaving critical section 119 | - : unit = () 120 | ``` 121 | 122 | A failed critical section will poison the mutex: 123 | 124 | ```ocaml 125 | # run @@ fun () -> 126 | let t = M.create () in 127 | try 128 | M.use_rw ~protect:true t (fun () -> failwith "Simulated error"); 129 | with Failure _ -> 130 | traceln "Trying to use the failed lock again fails:"; 131 | M.lock t;; 132 | +Trying to use the failed lock again fails: 133 | Exception: Eio__Eio_mutex.Poisoned (Failure "Simulated error"). 134 | ``` 135 | 136 | ## Protection 137 | 138 | We can prevent cancellation during a critical section: 139 | 140 | ```ocaml 141 | # run @@ fun () -> 142 | let t = M.create () in 143 | Fiber.both 144 | (fun () -> 145 | M.use_rw ~protect:true t (fun () -> Fiber.yield (); traceln "Restored invariant"); 146 | Fiber.check (); 147 | traceln "Error: not cancelled!"; 148 | ) 149 | (fun () -> traceln "Cancelling..."; failwith "Simulated error");; 150 | +Cancelling... 151 | +Restored invariant 152 | Exception: Failure "Simulated error". 153 | ``` 154 | 155 | Or allow interruption and disable the mutex: 156 | 157 | ```ocaml 158 | # run @@ fun () -> 159 | let t = M.create () in 160 | try 161 | Fiber.both 162 | (fun () -> 163 | M.use_rw ~protect:false t (fun () -> Fiber.yield (); traceln "Restored invariant") 164 | ) 165 | (fun () -> traceln "Cancelling..."; failwith "Simulated error"); 166 | with ex -> 167 | traceln "Trying to reuse the failed mutex..."; 168 | M.use_ro t (fun () -> assert false);; 169 | +Cancelling... 170 | +Trying to reuse the failed mutex... 171 | Exception: 172 | Eio__Eio_mutex.Poisoned 173 | (Eio__core__Exn.Cancelled (Failure "Simulated error")). 174 | ``` 175 | 176 | Protection doesn't prevent cancellation while we're still waiting for the lock, though: 177 | 178 | ```ocaml 179 | # run @@ fun () -> 180 | let t = M.create () in 181 | M.lock t; 182 | try 183 | Fiber.both 184 | (fun () -> M.use_rw ~protect:true t (fun () -> assert false)) 185 | (fun () -> traceln "Cancelling..."; failwith "Simulated error") 186 | with Failure _ -> 187 | M.unlock t; 188 | M.use_ro t (fun () -> traceln "Can reuse the mutex");; 189 | +Cancelling... 190 | +Can reuse the mutex 191 | - : unit = () 192 | ``` 193 | 194 | Poisoning wakes any wakers: 195 | 196 | ```ocaml 197 | # run @@ fun () -> 198 | let t = M.create () in 199 | Fiber.both 200 | (fun () -> 201 | try 202 | M.use_rw ~protect:false t (fun () -> 203 | Fiber.yield (); 204 | traceln "Poisoning mutex"; 205 | failwith "Simulated error" 206 | ) 207 | with Failure _ -> () 208 | ) 209 | (fun () -> traceln "Waiting for lock..."; M.use_ro t (fun () -> assert false));; 210 | +Waiting for lock... 211 | +Poisoning mutex 212 | Exception: Eio__Eio_mutex.Poisoned (Failure "Simulated error"). 213 | ``` 214 | 215 | 216 | ## Read-only access 217 | 218 | If the resource isn't being mutated, we can just unlock on error: 219 | 220 | ```ocaml 221 | # run @@ fun () -> 222 | let t = M.create () in 223 | try 224 | M.use_ro t (fun () -> failwith "Simulated error"); 225 | with Failure msg -> 226 | traceln "Caught: %s" msg; 227 | traceln "Trying to use the lock again is OK:"; 228 | M.lock t;; 229 | +Caught: Simulated error 230 | +Trying to use the lock again is OK: 231 | - : unit = () 232 | ``` 233 | 234 | ## Try_lock 235 | 236 | ```ocaml 237 | # run @@ fun () -> 238 | let t = M.create () in 239 | let fn () = 240 | match M.try_lock t with 241 | | true -> 242 | traceln "Entered critical section"; 243 | Fiber.yield (); 244 | traceln "Leaving critical section"; 245 | M.unlock t 246 | | false -> 247 | traceln "Failed to get lock" 248 | in 249 | Fiber.both fn fn; 250 | M.use_ro t (fun () -> traceln "Lock still works");; 251 | +Entered critical section 252 | +Failed to get lock 253 | +Leaving critical section 254 | +Lock still works 255 | - : unit = () 256 | ``` 257 | -------------------------------------------------------------------------------- /lib_eio/core/promise.ml: -------------------------------------------------------------------------------- 1 | (* Note on thread-safety 2 | 3 | Promises can be shared between domains, so everything here must be thread-safe. 4 | 5 | Wrapping everything in a mutex would be one way to do that, but that makes reads 6 | slow, and only one domain would be able to read at a time. 7 | 8 | Instead, we use an Atomic to hold the state, plus an additional mutex for the waiters 9 | while in the Unresolved state. This makes resolved promises faster (at the cost of 10 | making operations on unresolved promises a bit slower). It also makes reasoning about 11 | the code more fun. 12 | 13 | We can think of atomics and mutexes as "boxes", containing values and 14 | invariants. To use them, you open the box to get access to the contents, 15 | then close the box afterwards, restoring the invariant. For mutexes, 16 | open/close is lock/unlock. For atomics, every operation implicitly opens and 17 | closes the box. Any number of callers can share a reference to the box 18 | itself; the runtime ensures a box can only be opened by one user at a time. 19 | 20 | We can hold a full reference to something (meaning no-one else has access to it 21 | and we can mutate it), or a fraction (giving us read-only access but also 22 | ensuring that no-one else can mutate it either). *) 23 | 24 | type 'a state = 25 | | Resolved of 'a 26 | | Unresolved of 'a Waiters.t * Mutex.t 27 | (* The Unresolved state's mutex box contains: 28 | - Full access to the Waiters. 29 | - Half access to the promise's state. 30 | - The invariant that if the promise is resolved then the waiters list is empty. *) 31 | 32 | type !'a promise = { 33 | id : Ctf.id; 34 | 35 | state : 'a state Atomic.t; 36 | (* This atomic box contains either: 37 | - A non-zero share of the reference to the Resolved state. 38 | - A half-share of the reference to the Unresolved state. *) 39 | } 40 | 41 | type +!'a t 42 | type -!'a u 43 | 44 | type 'a or_exn = ('a, exn) result t 45 | 46 | let to_public_promise : 'a promise -> 'a t = Obj.magic 47 | let to_public_resolver : 'a promise -> 'a u = Obj.magic 48 | let of_public_promise : 'a t -> 'a promise = Obj.magic 49 | let of_public_resolver : 'a u -> 'a promise = Obj.magic 50 | 51 | let create_with_id id = 52 | let t = { 53 | id; 54 | state = Atomic.make (Unresolved (Waiters.create (), Mutex.create ())); 55 | } in 56 | to_public_promise t, to_public_resolver t 57 | 58 | let create ?label () = 59 | let id = Ctf.mint_id () in 60 | Ctf.note_created ?label id Ctf.Promise; 61 | create_with_id id 62 | 63 | let create_resolved x = 64 | let id = Ctf.mint_id () in 65 | Ctf.note_created id Ctf.Promise; 66 | to_public_promise { id; state = Atomic.make (Resolved x) } 67 | 68 | let await t = 69 | let t = of_public_promise t in 70 | match Atomic.get t.state with 71 | (* If the atomic is resolved, we take a share of that reference and return 72 | the remainder to the atomic (which will still be non-zero). We can then 73 | continue to know that the promise is resolved after the [Atomic.get]. *) 74 | | Resolved x -> 75 | Ctf.note_read t.id; 76 | x 77 | | Unresolved (q, mutex) -> 78 | (* We discovered that the promise was unresolved, but we can't be sure it still is, 79 | since we had to return the half-share reference to the atomic. So the [get] is 80 | just to get access to the mutex. *) 81 | Ctf.note_try_read t.id; 82 | Mutex.lock mutex; 83 | (* Having opened the mutex, we have: 84 | - Access to the waiters. 85 | - Half access to the promise's state (so we know it can't change until we close the mutex). 86 | - The mutex invariant. *) 87 | match Atomic.get t.state with 88 | | Unresolved _ -> 89 | (* The promise is unresolved, and can't change while we hold the mutex. 90 | It's therefore safe to add a new waiter (and let [Waiters.await] close the mutex). *) 91 | Waiters.await ~mutex:(Some mutex) q t.id 92 | (* Otherwise, the promise was resolved by the time we took the lock. 93 | Release the lock (which is fine, as we didn't change anything). *) 94 | | Resolved x -> 95 | Mutex.unlock mutex; 96 | Ctf.note_read t.id; 97 | x 98 | 99 | let await_exn t = 100 | match await t with 101 | | Ok x -> x 102 | | Error ex -> raise ex 103 | 104 | let resolve t v = 105 | let rec resolve' t v = 106 | match Atomic.get t.state with 107 | | Resolved _ -> invalid_arg "Can't resolve already-resolved promise" 108 | | Unresolved (q, mutex) as prev -> 109 | (* The above [get] just gets us access to the mutex; 110 | By the time we get here, the promise may have become resolved. *) 111 | Mutex.lock mutex; 112 | (* Having opened the mutex, we have: 113 | - Access to the waiters. 114 | - Half access to the promise's state (so we know it can't change until we close the mutex). 115 | - The mutex invariant. 116 | Now we open the atomic again, getting the other half access. Together, 117 | this gives us full access to the state (i.e. no-one else can be using 118 | it), allowing us to change it. 119 | Note: we don't actually need an atomic CAS here, just a get and a set 120 | would do, but this seems simplest. *) 121 | if Atomic.compare_and_set t.state prev (Resolved v) then ( 122 | (* The atomic now has half-access to the fullfilled state (which counts 123 | as non-zero), and we have the other half. Now we need to restore the 124 | mutex invariant by clearing the wakers. *) 125 | Ctf.note_resolved t.id ~ex:None; 126 | Waiters.wake_all q v; 127 | Mutex.unlock mutex 128 | ) else ( 129 | (* Otherwise, the promise was already resolved when we opened the mutex. 130 | Close it without any changes and retry. *) 131 | Mutex.unlock mutex; 132 | resolve' t v 133 | ) 134 | in 135 | resolve' (of_public_resolver t) v 136 | 137 | let resolve_ok u x = resolve u (Ok x) 138 | let resolve_error u x = resolve u (Error x) 139 | 140 | let peek t = 141 | let t = of_public_promise t in 142 | match Atomic.get t.state with 143 | | Unresolved _ -> None 144 | | Resolved x -> Some x 145 | 146 | let id t = 147 | let t = of_public_promise t in 148 | t.id 149 | 150 | let is_resolved t = 151 | Option.is_some (peek t) 152 | -------------------------------------------------------------------------------- /fuzz/fuzz_buf_read.ml: -------------------------------------------------------------------------------- 1 | (* This file contains a simple model of `Buf_read`, using a single string. 2 | It runs random operations on both the model and the real buffer and 3 | checks they always give the same result. *) 4 | 5 | open Astring 6 | 7 | let debug = false 8 | 9 | module Buf_read = Eio.Buf_read 10 | exception Buffer_limit_exceeded = Buf_read.Buffer_limit_exceeded 11 | 12 | let initial_size = 10 13 | let max_size = 100 14 | 15 | let mock_flow next = object (self) 16 | inherit Eio.Flow.source 17 | 18 | val mutable next = next 19 | 20 | method read_into buf = 21 | match next with 22 | | [] -> 23 | raise End_of_file 24 | | "" :: xs -> 25 | next <- xs; 26 | self#read_into buf 27 | | x :: xs -> 28 | let len = min (Cstruct.length buf) (String.length x) in 29 | Cstruct.blit_from_string x 0 buf 0 len; 30 | let x' = String.with_index_range x ~first:len in 31 | next <- (if x' = "" then xs else x' :: xs); 32 | len 33 | end 34 | 35 | module Model = struct 36 | type t = string ref 37 | 38 | let of_chunks chunks = ref (String.concat chunks) 39 | 40 | let take_all t = 41 | let old = !t in 42 | if String.length old >= max_size then raise Buffer_limit_exceeded; 43 | t := ""; 44 | old 45 | 46 | let line t = 47 | match String.cut ~sep:"\n" !t with 48 | | Some (line, rest) -> 49 | if String.length line >= max_size then raise Buffer_limit_exceeded; 50 | t := rest; 51 | if String.is_suffix ~affix:"\r" line then String.with_index_range line ~last:(String.length line - 2) 52 | else line 53 | | None when !t = "" -> raise End_of_file 54 | | None when String.length !t >= max_size -> raise Buffer_limit_exceeded 55 | | None -> take_all t 56 | 57 | let any_char t = 58 | match !t with 59 | | "" -> raise End_of_file 60 | | s -> 61 | t := String.with_index_range s ~first:1; 62 | String.get_head s 63 | 64 | let peek_char t = String.head !t 65 | 66 | let consume t n = 67 | t := String.with_index_range !t ~first:n 68 | 69 | let char c t = 70 | match peek_char t with 71 | | Some c2 when c = c2 -> consume t 1 72 | | Some _ -> failwith "char" 73 | | None -> raise End_of_file 74 | 75 | let string s t = 76 | if debug then Fmt.pr "string %S@." s; 77 | let len_t = String.length !t in 78 | if not (String.is_prefix ~affix:(String.with_range s ~len:len_t) !t) then failwith "string"; 79 | if String.length s > max_size then raise Buffer_limit_exceeded; 80 | if String.is_prefix ~affix:s !t then consume t (String.length s) 81 | else raise End_of_file 82 | 83 | let take n t = 84 | if n < 0 then invalid_arg "neg"; 85 | if n > max_size then raise Buffer_limit_exceeded 86 | else if String.length !t >= n then ( 87 | let data = String.with_range !t ~len:n in 88 | t := String.with_range !t ~first:n; 89 | data 90 | ) else raise End_of_file 91 | 92 | let take_while p t = 93 | match String.find (Fun.negate p) !t with 94 | | Some i when i >= max_size -> raise Buffer_limit_exceeded 95 | | Some i -> 96 | let data = String.with_range !t ~len:i in 97 | consume t i; 98 | data 99 | | None -> take_all t 100 | 101 | let skip_while p t = 102 | match String.find (Fun.negate p) !t with 103 | | Some i -> consume t i 104 | | None -> t := "" 105 | 106 | let skip n t = 107 | if n < 0 then invalid_arg "skip"; 108 | if n > String.length !t then ( 109 | t := ""; 110 | raise End_of_file; 111 | ); 112 | consume t n 113 | 114 | let end_of_input t = 115 | if !t <> "" then failwith "not eof" 116 | 117 | let rec lines t = 118 | match line t with 119 | | line -> line :: lines t 120 | | exception End_of_file -> [] 121 | end 122 | 123 | type op = Op : 'a Crowbar.printer * 'a Buf_read.parser * (Model.t -> 'a) -> op 124 | 125 | let unit = Fmt.(const string) "()" 126 | let dump_char f c = Fmt.pf f "%C" c 127 | 128 | let digit = function 129 | | '0'..'9' -> true 130 | | _ -> false 131 | 132 | let op = 133 | let label (name, gen) = Crowbar.with_printer Fmt.(const string name) gen in 134 | Crowbar.choose @@ List.map label [ 135 | "line", Crowbar.const @@ Op (Fmt.Dump.string, Buf_read.line, Model.line); 136 | "char 'x'", Crowbar.const @@ Op (unit, Buf_read.char 'x', Model.char 'x'); 137 | "any_char", Crowbar.const @@ Op (dump_char, Buf_read.any_char, Model.any_char); 138 | "peek_char", Crowbar.const @@ Op (Fmt.Dump.option dump_char, Buf_read.peek_char, Model.peek_char); 139 | "string", Crowbar.(map [bytes]) (fun s -> Op (unit, Buf_read.string s, Model.string s)); 140 | "take", Crowbar.(map [int]) (fun n -> Op (Fmt.Dump.string, Buf_read.take n, Model.take n)); 141 | "take_all", Crowbar.const @@ Op (Fmt.Dump.string, Buf_read.take_all, Model.take_all); 142 | "take_while digit", Crowbar.const @@ Op (Fmt.Dump.string, Buf_read.take_while digit, Model.take_while digit); 143 | "skip_while digit", Crowbar.const @@ Op (unit, Buf_read.skip_while digit, Model.skip_while digit); 144 | "skip", Crowbar.(map [int]) (fun n -> Op (unit, Buf_read.skip n, Model.skip n)); 145 | "end_of_input", Crowbar.const @@ Op (unit, Buf_read.end_of_input, Model.end_of_input); 146 | "lines", Crowbar.const @@ Op (Fmt.Dump.(list string), (Buf_read.(map List.of_seq lines)), Model.lines); 147 | ] 148 | 149 | let catch f x = 150 | match f x with 151 | | y -> Ok y 152 | | exception End_of_file -> Error "EOF" 153 | | exception Invalid_argument _ -> Error "Invalid" 154 | | exception Failure _ -> Error "Failure" 155 | | exception Buffer_limit_exceeded -> Error "TooBig" 156 | 157 | let random chunks ops = 158 | let model = Model.of_chunks chunks in 159 | let chunks_len = String.length !model in 160 | let r = Buf_read.of_flow (mock_flow chunks) ~initial_size ~max_size in 161 | if debug then print_endline "*** start ***"; 162 | let check_eq (Op (pp, a, b)) = 163 | if debug then ( 164 | Fmt.pr "---@."; 165 | Fmt.pr "real :%S@." (Cstruct.to_string (Buf_read.peek r)); 166 | Fmt.pr "model:%S@." !model; 167 | ); 168 | let x = catch a r in 169 | let y = catch b model in 170 | Crowbar.check_eq ~pp:Fmt.(result ~ok:pp ~error:string) x y 171 | in 172 | List.iter check_eq ops; 173 | Crowbar.check_eq ~pp:Fmt.int (Buf_read.consumed_bytes r) (chunks_len - String.length !model) 174 | 175 | let () = 176 | Crowbar.(add_test ~name:"random ops" [list bytes; list op] random) 177 | -------------------------------------------------------------------------------- /lib_eio/mock/eio_mock.mli: -------------------------------------------------------------------------------- 1 | (** Mocks for testing. 2 | 3 | When testing an Eio program it is often convenient to use mock resources rather than real OS-provided ones. 4 | This allows precise control over the test, such as adding delays or simulated faults. 5 | You can always just implement the various Eio types directly, 6 | but this module provides some convenient pre-built mocks, and some helpers for creating your own mocks. 7 | 8 | Mocks typically use {!Eio.traceln} to record how they were used. 9 | This output can be recorded and compared against a known-good copy using e.g. 10 | {{:https://github.com/realworldocaml/mdx}ocaml-mdx}. 11 | 12 | Mocks may require configuration. 13 | For example, a source flow needs to know what data to return when the application reads from it. 14 | This can be done using the various [on_*] functions. For example: 15 | 16 | {[ 17 | let stdin = Eio_mock.Flow.make "stdin" in 18 | let stdout = Eio_mock.Flow.make "stdout" in 19 | Eio_mock.Flow.on_read stdin [ 20 | `Return "chunk1"; 21 | `Return "chunk2"; 22 | `Raise End_of_file 23 | ]; 24 | Eio.Flow.copy stdin stdout 25 | ]} 26 | 27 | This will produce: 28 | 29 | {[ 30 | +stdin: read "chunk1" 31 | +stdout: wrote "chunk1" 32 | +stdin: read "chunk2" 33 | +stdout: wrote "chunk2" 34 | ]} 35 | *) 36 | 37 | (** {2 Configuration} *) 38 | 39 | (** Actions that can be performed by mock handlers. *) 40 | module Action : sig 41 | type 'a t = [ 42 | | `Return of 'a (** Immediately return a value *) 43 | | `Raise of exn (** Raise an exception *) 44 | | `Await of 'a Eio.Promise.or_exn (** Wait for a promise to resolve *) 45 | | `Yield_then of 'a t (** Call {!Eio.Fiber.yield}, then perform an action *) 46 | | `Run of unit -> 'a (** Run any code you like. *) 47 | ] 48 | 49 | val run : 'a t -> 'a 50 | (** [run t] performs action [t] and returns the result. *) 51 | 52 | val map : ('a -> 'b) -> 'a t -> 'b t 53 | (** [run (map f t) = f (run t)]. *) 54 | end 55 | 56 | (** Control how a mock responds. 57 | 58 | This module is mostly useful when writing custom mocks. 59 | Individual mocks usually provide convenience wrappers around this. *) 60 | module Handler : sig 61 | type 'a t 62 | (** A handler that provides values of type ['a]. *) 63 | 64 | type 'a actions = 'a Action.t list 65 | 66 | val make : 'a Action.t -> 'a t 67 | (** [make default_action] is a new handler that initially always runs [default_action]. *) 68 | 69 | val set_handler : 'a t -> (unit -> 'a) -> unit 70 | (** [set_handler t fn] sets (replaces) the function to be called whenever the handler is run. *) 71 | 72 | val seq : 'a t -> 'a actions -> unit 73 | (** [seq t actions] sets a handler function that performs the next action in [actions] on each call. 74 | When there are no more actions, it runs the default handler. *) 75 | 76 | val run : 'a t -> 'a 77 | (** [run t] is used by mocks to run their handlers. *) 78 | 79 | val run_default_action : 'a t -> 'a 80 | (** [run_default_action t] runs the default handler passed to {!make}. *) 81 | end 82 | 83 | (** {2 Pre-defined mocks} *) 84 | 85 | (** Mock {!Eio.Flow} sources and sinks. *) 86 | module Flow : sig 87 | type copy_method = [ 88 | | `Read_into (** Use the source's [read_into] method (the default). *) 89 | | `Read_source_buffer (** Use the {!Eio.Flow.Read_source_buffer} optimisation. *) 90 | ] 91 | 92 | type t = < 93 | Eio.Flow.two_way; 94 | Eio.Flow.close; 95 | on_read : string Handler.t; 96 | on_copy_bytes : int Handler.t; 97 | set_copy_method : copy_method -> unit; 98 | attach_to_switch : Eio.Switch.t -> unit; 99 | > 100 | 101 | val make : ?pp:string Fmt.t -> string -> t 102 | (** [make label] is a mock Eio flow. 103 | It can be used as a source, sink, or two-way flow. 104 | @param pp Printer to use to display the data. *) 105 | 106 | val on_read : t -> string Handler.actions -> unit 107 | (** [on_read t actions] configures the values to return from the mock's [read] function. *) 108 | 109 | val on_copy_bytes : t -> int Handler.actions -> unit 110 | (** [on_copy_bytes t actions] configures the number of bytes to copy in each iteration. *) 111 | 112 | val set_copy_method : t -> copy_method -> unit 113 | (** [set_copy_method t m] configures [t] to use the given method to read from 114 | a source during a copy operation. *) 115 | end 116 | 117 | (** Mock {!Eio.Net} networks and sockets. *) 118 | module Net : sig 119 | type t = < 120 | Eio.Net.t; 121 | on_listen : Eio.Net.listening_socket Handler.t; 122 | on_connect : Handler.t; 123 | on_datagram_socket : Handler.t; 124 | on_getaddrinfo : Eio.Net.Sockaddr.t list Handler.t; 125 | on_getnameinfo : (string * string) Handler.t; 126 | > 127 | 128 | type listening_socket = < 129 | Eio.Net.listening_socket; 130 | on_accept : (Flow.t * Eio.Net.Sockaddr.stream) Handler.t; 131 | > 132 | 133 | val make : string -> t 134 | (** [make label] is a new mock network. *) 135 | 136 | val on_connect : t -> Handler.actions -> unit 137 | (** [on_connect t actions] configures what to do when a client tries to connect somewhere. *) 138 | 139 | val on_listen : t -> #Eio.Net.listening_socket Handler.actions -> unit 140 | (** [on_listen t actions] configures what to do when a server starts listening for incoming connections. *) 141 | 142 | val on_datagram_socket : t -> Handler.actions -> unit 143 | (** [on_datagram_socket t actions] configures how to create datagram sockets. *) 144 | 145 | val on_getaddrinfo : t -> Eio.Net.Sockaddr.t list Handler.actions -> unit 146 | 147 | val on_getnameinfo : t -> (string * string) Handler.actions -> unit 148 | 149 | val listening_socket : string -> listening_socket 150 | (** [listening_socket label] can be configured to provide mock connections. *) 151 | 152 | val on_accept : 153 | listening_socket -> 154 | (Flow.t * Eio.Net.Sockaddr.stream) Handler.actions -> 155 | unit 156 | (** [on_accept socket actions] configures how to respond when the server calls "accept". *) 157 | end 158 | 159 | (** {2 Backend for mocks} 160 | 161 | The mocks can be used with any backend, but if you don't need any IO then you can use this one 162 | to avoid a dependency on eio_main. *) 163 | 164 | module Backend = Backend 165 | -------------------------------------------------------------------------------- /lib_eio/net.ml: -------------------------------------------------------------------------------- 1 | exception Connection_reset of exn 2 | (** This is a wrapper for EPIPE, ECONNRESET and similar errors. 3 | It indicates that the flow has failed, and data may have been lost. *) 4 | 5 | 6 | module Ipaddr = struct 7 | type 'a t = string (* = [Unix.inet_addr], but avoid a Unix dependency here *) 8 | 9 | module V4 = struct 10 | let any = "\000\000\000\000" 11 | let loopback = "\127\000\000\001" 12 | 13 | let pp f t = 14 | Fmt.pf f "%d.%d.%d.%d" 15 | (Char.code t.[0]) 16 | (Char.code t.[1]) 17 | (Char.code t.[2]) 18 | (Char.code t.[3]) 19 | end 20 | 21 | module V6 = struct 22 | let any = "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000" 23 | let loopback = "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001" 24 | 25 | let to_int16 t = 26 | let get i = Char.code (t.[i]) in 27 | let pair i = (get i lsl 8) lor (get (i + 1)) in 28 | List.init 8 (fun i -> pair (i * 2)) 29 | 30 | (* [calc_elide elide zeros acc parts] finds the best place for the "::" 31 | when printing an IPv6 address. 32 | Returns [None, rev t] if there are no pairs of zeros, or 33 | [Some (-n), rev t'] where [n] is the length of the longest run of zeros 34 | and [t'] is [t] with all runs of zeroes replaced with [-len_run]. *) 35 | let calc_elide t = 36 | (* [elide] is the negative of the length of the best previous run of zeros seen. 37 | [zeros] is the current run. 38 | [acc] is the values seen so far, with runs of zeros replaced by a 39 | negative value giving the length of the run. *) 40 | let rec loop elide zeros acc = function 41 | | 0 :: xs -> loop elide (zeros - 1) acc xs 42 | | n :: xs when zeros = 0 -> loop elide 0 (n :: acc) xs 43 | | n :: xs -> loop (min elide zeros) 0 (n :: zeros :: acc) xs 44 | | [] -> 45 | let elide = min elide zeros in 46 | let parts = if zeros = 0 then acc else zeros :: acc in 47 | ((if elide < -1 then Some elide else None), List.rev parts) 48 | 49 | in 50 | loop 0 0 [] t 51 | 52 | let rec cons_zeros l x = 53 | if x >= 0 then l else cons_zeros (Some 0 :: l) (x + 1) 54 | 55 | let elide l = 56 | let rec aux ~elide = function 57 | | [] -> [] 58 | | x :: xs when x >= 0 -> 59 | Some x :: aux ~elide xs 60 | | x :: xs when Some x = elide -> 61 | None :: aux ~elide:None xs 62 | | z :: xs -> 63 | cons_zeros (aux ~elide xs) z 64 | in 65 | let elide, l = calc_elide l in 66 | assert (match elide with Some x when x < -8 -> false | _ -> true); 67 | aux ~elide l 68 | 69 | (* Based on https://github.com/mirage/ocaml-ipaddr/ 70 | See http://tools.ietf.org/html/rfc5952 *) 71 | let pp f t = 72 | let comp = to_int16 t in 73 | let v4 = match comp with [0; 0; 0; 0; 0; 0xffff; _; _] -> true | _ -> false in 74 | let l = elide comp in 75 | let rec fill = function 76 | | [ Some hi; Some lo ] when v4 -> 77 | Fmt.pf f "%d.%d.%d.%d" 78 | (hi lsr 8) (hi land 0xff) 79 | (lo lsr 8) (lo land 0xff) 80 | | None :: xs -> 81 | Fmt.string f "::"; 82 | fill xs 83 | | [ Some n ] -> Fmt.pf f "%x" n 84 | | Some n :: None :: xs -> 85 | Fmt.pf f "%x::" n; 86 | fill xs 87 | | Some n :: xs -> 88 | Fmt.pf f "%x:" n; 89 | fill xs 90 | | [] -> () 91 | in 92 | fill l 93 | end 94 | 95 | type v4v6 = [`V4 | `V6] t 96 | 97 | let fold ~v4 ~v6 t = 98 | match String.length t with 99 | | 4 -> v4 t 100 | | 16 -> v6 t 101 | | _ -> assert false 102 | 103 | let of_raw t = 104 | match String.length t with 105 | | 4 | 16 -> t 106 | | x -> Fmt.invalid_arg "An IP address must be either 4 or 16 bytes long (%S is %d bytes)" t x 107 | 108 | let pp f = fold ~v4:(V4.pp f) ~v6:(V6.pp f) 109 | 110 | let pp_for_uri f = 111 | fold 112 | ~v4:(V4.pp f) 113 | ~v6:(Fmt.pf f "[%a]" V6.pp) 114 | end 115 | 116 | module Sockaddr = struct 117 | type stream = [ 118 | | `Unix of string 119 | | `Tcp of Ipaddr.v4v6 * int 120 | ] 121 | 122 | type datagram = [ 123 | | `Udp of Ipaddr.v4v6 * int 124 | ] 125 | 126 | type t = [ stream | datagram ] 127 | 128 | let pp f = function 129 | | `Unix path -> 130 | Format.fprintf f "unix:%s" path 131 | | `Tcp (addr, port) -> 132 | Format.fprintf f "tcp:%a:%d" Ipaddr.pp_for_uri addr port 133 | | `Udp (addr, port) -> 134 | Format.fprintf f "udp:%a:%d" Ipaddr.pp_for_uri addr port 135 | end 136 | 137 | class virtual socket = object (_ : #Generic.t) 138 | method probe _ = None 139 | end 140 | 141 | class virtual stream_socket = object 142 | inherit Flow.two_way 143 | end 144 | 145 | class virtual listening_socket = object 146 | inherit socket 147 | method virtual accept : sw:Switch.t -> * Sockaddr.stream 148 | method virtual close : unit 149 | end 150 | 151 | let accept ~sw (t : #listening_socket) = t#accept ~sw 152 | 153 | let accept_fork ~sw (t : #listening_socket) ~on_error handle = 154 | let child_started = ref false in 155 | let flow, addr = accept ~sw t in 156 | Fun.protect ~finally:(fun () -> if !child_started = false then Flow.close flow) 157 | (fun () -> 158 | Fiber.fork ~sw (fun () -> 159 | match child_started := true; handle (flow :> stream_socket) addr with 160 | | x -> Flow.close flow; x 161 | | exception ex -> 162 | Flow.close flow; 163 | on_error ex 164 | ) 165 | ) 166 | 167 | let accept_sub ~sw (t : #listening_socket) ~on_error handle = 168 | accept_fork ~sw t ~on_error (fun flow addr -> Switch.run (fun sw -> handle ~sw flow addr)) 169 | 170 | class virtual datagram_socket = object 171 | inherit socket 172 | method virtual send : Sockaddr.datagram -> Cstruct.t -> unit 173 | method virtual recv : Cstruct.t -> Sockaddr.datagram * int 174 | end 175 | 176 | let send (t:#datagram_socket) = t#send 177 | let recv (t:#datagram_socket) = t#recv 178 | 179 | class virtual t = object 180 | method virtual listen : reuse_addr:bool -> reuse_port:bool -> backlog:int -> sw:Switch.t -> Sockaddr.stream -> listening_socket 181 | method virtual connect : sw:Switch.t -> Sockaddr.stream -> 182 | method virtual datagram_socket : sw:Switch.t -> Sockaddr.datagram -> 183 | method virtual getaddrinfo : service:string -> string -> Sockaddr.t list 184 | method virtual getnameinfo : Sockaddr.t -> (string * string) 185 | end 186 | 187 | let listen ?(reuse_addr=false) ?(reuse_port=false) ~backlog ~sw (t:#t) = t#listen ~reuse_addr ~reuse_port ~backlog ~sw 188 | let connect ~sw (t:#t) = t#connect ~sw 189 | 190 | let datagram_socket ~sw (t:#t) = t#datagram_socket ~sw 191 | 192 | let getaddrinfo ?(service="") (t:#t) hostname = t#getaddrinfo ~service hostname 193 | 194 | let getaddrinfo_stream ?service t hostname = 195 | getaddrinfo ?service t hostname 196 | |> List.filter_map (function 197 | | #Sockaddr.stream as x -> Some x 198 | | _ -> None 199 | ) 200 | 201 | let getaddrinfo_datagram ?service t hostname = 202 | getaddrinfo ?service t hostname 203 | |> List.filter_map (function 204 | | #Sockaddr.datagram as x -> Some x 205 | | _ -> None 206 | ) 207 | 208 | let getnameinfo (t:#t) sockaddr = t#getnameinfo sockaddr 209 | 210 | let close = Flow.close 211 | --------------------------------------------------------------------------------