diff --git a/README.md b/README.md index f43896b99..5a8c19d92 100644 --- a/README.md +++ b/README.md @@ -24,12 +24,12 @@ Eio replaces existing concurrency libraries such as Lwt * [Cancellation](#cancellation) * [Racing](#racing) * [Switches](#switches) -* [Design Note: Results vs Exceptions](#design-note-results-vs-exceptions) * [Performance](#performance) * [Networking](#networking) * [Design Note: Capabilities](#design-note-capabilities) * [Buffered Reading and Parsing](#buffered-reading-and-parsing) * [Buffered Writing](#buffered-writing) +* [Error Handling](#error-handling) * [Filesystem Access](#filesystem-access) * [Time](#time) * [Multicore Support](#multicore-support) @@ -364,18 +364,6 @@ Every switch also creates a new cancellation context. You can use `Switch.fail` to mark the switch as failed and cancel all fibers within it. The exception (or exceptions) passed to `fail` will be raised by `run` when the fibers have exited. -## Design Note: Results vs Exceptions - -The OCaml standard library uses exceptions to report errors in most cases. -Many libraries instead use the `result` type, which has the advantage of tracking the possible errors in the type system. -However, using `result` is slower, as it requires more allocations, and explicit code to propagate errors. - -As part of the effects work, OCaml is expected to gain a [typed effects][] extension to the type system, -allowing it to track both effects and exceptions statically. -In anticipation of this, the Eio library prefers to use exceptions in most cases, -reserving the use of `result` for cases where the caller is likely to want to handle the problem immediately -rather than propagate it. - ## Performance As mentioned above, Eio allows you to supply your own implementations of its abstract interfaces. @@ -707,6 +695,97 @@ let send_response socket = Now the first two writes were combined and sent together. +## Error Handling + +Errors interacting with the outside world are indicated by the `Eio.Io (err, context)` exception. +This is roughly equivalent to the `Unix.Unix_error` exception from the OCaml standard library. + +The `err` field describes the error using nested error codes, +allowing you to match on either specific errors or whole classes of errors at once. +For example: + +```ocaml +let test r = + try Eio.Buf_read.line r + with + | Eio.Io (Eio.Net.E Connection_reset Eio_luv.Luv_error _, _) -> "Luv connection reset" + | Eio.Io (Eio.Net.E Connection_reset _, _) -> "Connection reset" + | Eio.Io (Eio.Net.E _, _) -> "Some network error" + | Eio.Io _ -> "Some I/O error" +``` + +For portable code, you will want to avoid matching backend-specific errors, so you would avoid the first case. +The `Eio.Io` type is extensible, so libraries can also add additional top-level error types if needed. + +`Io` errors also allow adding extra context information to the error. +For example, this HTTP GET function adds the URL to any IO error: + +```ocaml +# let get ~net ~host ~path = + try + Eio.Net.with_tcp_connect net ~host ~service:"http" @@ fun _flow -> + "..." + with Eio.Io _ as ex -> + let bt = Printexc.get_raw_backtrace () in + Eio.Exn.reraise_with_context ex bt "fetching http://%s/%s" host path;; +val get : net:#Eio.Net.t -> host:string -> path:string -> string = +``` + +If we test it using a mock network that returns a timeout, +we get a useful error message telling us the IP address and port of the failed attempt, +extended with the hostname we used to get that, +and then extended again by our `get` function with the full URL: + +```ocaml +# Eio_mock.Backend.run @@ fun () -> + let net = Eio_mock.Net.make "mocknet" in + Eio_mock.Net.on_getaddrinfo net [`Return [`Tcp (Eio.Net.Ipaddr.V4.loopback, 80)]]; + Eio_mock.Net.on_connect net [`Raise (Eio.Net.err (Connection_failure Timeout))]; + get ~net ~host:"example.com" ~path:"index.html";; ++mocknet: getaddrinfo ~service:http example.com ++mocknet: connect to tcp:127.0.0.1:80 +Exception: +Eio.Io Net Connection_failure Timeout, + connecting to tcp:127.0.0.1:80, + connecting to "example.com":http, + fetching http://example.com/index.html +``` + +To get more detailed information, you can enable backtraces by setting `OCAMLRUNPARAM=b` +or by calling `Printexc.record_backtrace true`, as usual. + +When writing MDX tests that depend on getting the exact error output, +it can be annoying to have the full backend-specific error displayed: + + +```ocaml +# Eio_main.run @@ fun env -> + let net = Eio.Stdenv.net env in + Switch.run @@ fun sw -> + Eio.Net.connect ~sw net (`Tcp (Eio.Net.Ipaddr.V4.loopback, 1234));; +Exception: +Eio.Io Net Connection_failure Refused Eio_luv.Luv_error(ECONNREFUSED) (* connection refused *), + connecting to tcp:127.0.0.1:1234 +``` + +If we ran this using e.g. the Linux io_uring backend, the `Luv_error` part would change. +To avoid this problem, you can use `Eio.Exn.Backend.show` to hide the backend-specific part of errors: + +```ocaml +# Eio.Exn.Backend.show := false;; +- : unit = () + +# Eio_main.run @@ fun env -> + let net = Eio.Stdenv.net env in + Switch.run @@ fun sw -> + Eio.Net.connect ~sw net (`Tcp (Eio.Net.Ipaddr.V4.loopback, 1234));; +Exception: +Eio.Io Net Connection_failure Refused _, + connecting to tcp:127.0.0.1:1234 +``` + +We'll leave it like that for the rest of this file, +so the examples can be tested automatically by MDX. ## Filesystem Access @@ -756,13 +835,13 @@ Access to `cwd` only grants access to that sub-tree: ```ocaml let try_save path data = match Eio.Path.save ~create:(`Exclusive 0o600) path data with - | () -> traceln "save %a -> ok" Eio.Path.pp path - | exception ex -> traceln "save %a -> %a" Eio.Path.pp path Fmt.exn ex + | () -> traceln "save %a : ok" Eio.Path.pp path + | exception ex -> traceln "%a" Eio.Exn.pp ex let try_mkdir path = match Eio.Path.mkdir path ~perm:0o700 with - | () -> traceln "mkdir %a -> ok" Eio.Path.pp path - | exception ex -> traceln "mkdir %a -> %a" Eio.Path.pp path Fmt.exn ex + | () -> traceln "mkdir %a : ok" Eio.Path.pp path + | exception ex -> traceln "%a" Eio.Exn.pp ex ``` ```ocaml @@ -771,9 +850,9 @@ let try_mkdir path = try_mkdir (cwd / "dir1"); try_mkdir (cwd / "../dir2"); try_mkdir (cwd / "/tmp/dir3");; -+mkdir -> ok -+mkdir -> Eio__Fs.Permission_denied("../dir2", _) -+mkdir -> Eio__Fs.Permission_denied("/tmp/dir3", _) ++mkdir : ok ++Eio.Io Fs Permission_denied _, creating directory ++Eio.Io Fs Permission_denied _, creating directory - : unit = () ``` @@ -788,9 +867,9 @@ The checks also apply to following symlinks: try_save (cwd / "dir1/file1") "A"; try_save (cwd / "link-to-dir1/file2") "B"; try_save (cwd / "link-to-tmp/file3") "C";; -+save -> ok -+save -> ok -+save -> Eio__Fs.Permission_denied("link-to-tmp/file3", _) ++save : ok ++save : ok ++Eio.Io Fs Permission_denied _, opening - : unit = () ``` @@ -802,8 +881,8 @@ You can use `open_dir` (or `with_open_dir`) to create a restricted capability to Eio.Path.with_open_dir (cwd / "dir1") @@ fun dir1 -> try_save (dir1 / "file4") "D"; try_save (dir1 / "../file5") "E";; -+save -> ok -+save -> Eio__Fs.Permission_denied("../file5", _) ++save : ok ++Eio.Io Fs Permission_denied _, opening - : unit = () ``` @@ -1446,7 +1525,6 @@ Some background about the effects system can be found in: [Lwt_eio]: https://github.com/ocaml-multicore/lwt_eio [mirage-trace-viewer]: https://github.com/talex5/mirage-trace-viewer [structured concurrency]: https://en.wikipedia.org/wiki/Structured_concurrency -[typed effects]: https://www.janestreet.com/tech-talks/effective-programming/ [capability-based security]: https://en.wikipedia.org/wiki/Object-capability_model [Emily]: https://www.hpl.hp.com/techreports/2006/HPL-2006-116.pdf [gemini-eio]: https://gitlab.com/talex5/gemini-eio diff --git a/doc/rationale.md b/doc/rationale.md index d11bfae50..1140d1bb0 100644 --- a/doc/rationale.md +++ b/doc/rationale.md @@ -151,3 +151,22 @@ or add extra convenience functions without forcing every implementor to add them Note that the use of objects in Eio is not motivated by the use of the "Object Capabilities" security model. Despite the name, that is not specific to objects at all. + +## Results vs Exceptions + +The OCaml standard library uses exceptions to report errors in most cases. +Many libraries instead use the `result` type, which has the advantage of tracking the possible errors in the type system. +However, using `result` is slower, as it requires more allocations, and explicit code to propagate errors. + +As part of the effects work, OCaml is expected to gain a [typed effects][] extension to the type system, +allowing it to track both effects and exceptions statically. +In anticipation of this, the Eio library prefers to use exceptions in most cases, +reserving the use of `result` for cases where the caller is likely to want to handle the problem immediately +rather than propagate it. + +In additional, while result types work well +for functions with a small number of known errors which can be handled at the call-site, +they work poorly for IO errors where there are typically a large and unknown set of possible errors +(depending on the backend). + +[typed effects]: https://www.janestreet.com/tech-talks/effective-programming/ diff --git a/lib_eio/core/eio__core.mli b/lib_eio/core/eio__core.mli index e4aa27290..08975ea84 100644 --- a/lib_eio/core/eio__core.mli +++ b/lib_eio/core/eio__core.mli @@ -358,19 +358,112 @@ end module Exn : sig type with_bt = exn * Printexc.raw_backtrace - exception Multiple of exn list - (** Raised if multiple fibers fail, to report all the exceptions. *) + type err = .. + (** Describes the particular error that occurred. + + They are typically nested (e.g. [Fs (Permission_denied (Unix_error ...))]) + so that you can match e.g. all IO errors, all file-system errors, all + permission denied errors, etc. + + If you extend this, use {!register_pp} to add a printer for the new error. *) + + type context + (** Extra information attached to an IO error. + This provides contextual information about what caused the error. *) + + exception Io of err * context + (** A general purpose IO exception. + + This is used for most errors interacting with the outside world, + and is similar to {!Unix.Unix_error}, but more general. + An unknown [Io] error should typically be reported to the user, but does + not generally indicate a bug in the program. *) + + type err += Multiple_io of (err * context * Printexc.raw_backtrace) list + (** Error code used when multiple IO errors occur. + + This is useful if you want to catch and report all IO errors. *) + + val create : err -> exn + (** [create err] is an {!Io} exception with an empty context. *) + + val add_context : exn -> ('a, Format.formatter, unit, exn) format4 -> 'a + (** [add_context ex msg] returns a new exception with [msg] added to [ex]'s context, + if [ex] is an {!Io} exception. + + If [ex] is not an [Io] exception, this function just returns the original exception. *) + + val reraise_with_context : exn -> Printexc.raw_backtrace -> ('a, Format.formatter, unit, 'b) format4 -> 'a + (** [reraise_with_context ex bt msg] raises [ex] extended with additional information [msg]. + + [ex] should be an {!Io} exception (if not, is re-raised unmodified). + + Example: + {[ + try connect addr + with Eio.Io _ as ex -> + let bt = Printexc.get_raw_backtrace () in + reraise_with_context ex bt "connecting to %S" addr + ]} + + You must get the backtrace before calling any other function + in the exception handler to prevent corruption of the backtrace. *) + + val register_pp : (Format.formatter -> err -> bool) -> unit + (** [register_pp pp] adds [pp] as a pretty-printer of errors. + + [pp f err] should format [err] using [f], if possible. + It should return [true] on success, or [false] if it didn't + recognise [err]. *) + + val pp : exn Fmt.t + (** [pp] is a formatter for exceptions. + + This is similar to {!Fmt.exn}, but can do a better job on {!Io} exceptions + because it can format them directly without having to convert to a string first. *) + + (** Extensible backend-specific exceptions. *) + module Backend : sig + type t = .. + + val show : bool ref + (** Controls the behaviour of {!pp}. *) + + val register_pp : (Format.formatter -> t -> bool) -> unit + (** [register_pp pp] adds [pp] as a pretty-printer of backend errors. + + [pp f err] should format [err] using [f], if possible. + It should return [true] on success, or [false] if it didn't + recognise [err]. *) + + val pp : t Fmt.t + (** [pp] behaves like {!pp} except that if display of backend errors has been turned off + (with {!show}) then it just prints a place-holder. + + This is useful for formatting the backend-specific part of exceptions, + which should be hidden in expect-style testing that needs to work on multiple backends. *) + end + + type err += X of Backend.t + (** A top-level code for backend errors that don't yet have a cross-platform classification in Eio. + + You should avoid matching on these (in portable code). Instead, request a proper Eio code for them. *) + + exception Multiple of with_bt list + (** Raised if multiple fibers fail, to report all the exceptions. + + This usually indicates a bug in the program. + + Note: If multiple {b IO} errors occur, then you will get [Io (Multiple_io _, _)] instead of this. *) val combine : with_bt -> with_bt -> with_bt (** [combine x y] returns a single exception and backtrace to use to represent two errors. - Only one of the backtraces will be kept. The resulting exception is typically just [Multiple [y; x]], but various heuristics are used to simplify the result: - Combining with a {!Cancel.Cancelled} exception does nothing, as these don't need to be reported. The result is only [Cancelled] if there is no other exception available. - - If [x] is a [Multiple] exception then [y] is added to it, to avoid nested [Multiple] exceptions. - - Duplicate exceptions are removed (using physical equality of the exception). *) + - If both errors are [Io] errors, then the result is [Io (Multiple_io _)]. *) end (** @canonical Eio.Cancel *) diff --git a/lib_eio/core/exn.ml b/lib_eio/core/exn.ml index 1241ea8a4..7f39360ee 100644 --- a/lib_eio/core/exn.ml +++ b/lib_eio/core/exn.ml @@ -1,14 +1,95 @@ +let show_backend_exceptions = ref true + type with_bt = exn * Printexc.raw_backtrace -exception Multiple of exn list (* Note: the last exception in list is the first one reported *) +type err = .. + +type context = { + steps : string list; +} + +exception Io of err * context + +exception Multiple of (exn * Printexc.raw_backtrace) list (* Note: the last exception in list is the first one reported *) + +type err += Multiple_io of (err * context * Printexc.raw_backtrace) list exception Cancelled of exn exception Cancel_hook_failed of exn list +let create err = Io (err, { steps = [] }) + +let add_context ex fmt = + fmt |> Fmt.kstr @@ fun msg -> + match ex with + | Io (code, t) -> Io (code, {steps = msg :: t.steps}) + | ex -> ex + +let reraise_with_context ex bt fmt = + fmt |> Fmt.kstr @@ fun msg -> + match ex with + | Io (code, t) -> + let context = { steps = msg :: t.steps } in + Printexc.raise_with_backtrace (Io (code, context)) bt + | _ -> + Printexc.raise_with_backtrace ex bt + +let err_printers : (Format.formatter -> err -> bool) list ref = ref [] + +let register_pp fn = + err_printers := fn :: !err_printers + +let break f _ = Format.pp_print_custom_break f + ~fits:(",", 1, "") + ~breaks:(",", 2, "") + +let pp_err f x = + let rec aux = function + | [] -> Fmt.string f "?" + | pp :: pps -> if not (pp f x) then aux pps + in + aux !err_printers + +let pp_with_context f (code, context) = + Fmt.pf f "%a%a" pp_err code + Fmt.(list ~sep:nop (break ++ string)) (List.rev context.steps) + +let pp_with_bt f (code, context, bt) = + match String.trim (Printexc.raw_backtrace_to_string bt) with + | "" -> + Fmt.pf f "- @[%a@]" + pp_with_context (code, context) + | bt -> + Fmt.pf f "- @[%a@,%a@]" + pp_with_context (code, context) + Fmt.lines bt + +let pp f = function + | Io (code, t) -> + Fmt.pf f "Eio.Io %a%a" + pp_err code + Fmt.(list ~sep:nop (break ++ string)) (List.rev t.steps) + | ex -> + Fmt.string f (Printexc.to_string ex) + +let pp_multiple f exns = + let pp_with_bt f (ex, bt) = + match String.trim (Printexc.raw_backtrace_to_string bt) with + | "" -> + Fmt.pf f "- @[%a@]" pp ex + | bt -> + Fmt.pf f "- @[%a@,%a@]" + pp ex + Fmt.lines bt + in + Fmt.pf f "@[Multiple exceptions:@,%a@]" + (Fmt.(list ~sep:cut) pp_with_bt) (List.rev exns) + let () = Printexc.register_printer @@ function - | Multiple exns -> Some ("Multiple exceptions:\n" ^ String.concat "\nand\n" (List.rev_map Printexc.to_string exns)) + | Io _ as ex -> Some (Fmt.str "@[%a@]" pp ex) + | Multiple exns -> Some (Fmt.str "%a" pp_multiple exns) | Cancel_hook_failed exns -> Some ("During cancellation:\n" ^ String.concat "\nand\n" (List.map Printexc.to_string exns)) | Cancelled ex -> Some ("Cancelled: " ^ Printexc.to_string ex) | _ -> None @@ -18,6 +99,35 @@ let combine e1 e2 = else match e1, e2 with | (Cancelled _, _), e | e, (Cancelled _, _) -> e (* Don't need to report a cancelled exception if we have something better *) - | (Multiple exs, _), _ when List.memq (fst e2) exs -> e1 (* Avoid duplicates *) - | (Multiple exs, bt1), (e2, _) -> Multiple (e2 :: exs), bt1 - | (e1, bt1), (e2, _) -> Multiple [e2; e1], bt1 + | (Io (c1, t1), bt1), (Io (c2, t2), bt2) -> create (Multiple_io [(c1, t1, bt1); (c2, t2, bt2)]), Printexc.get_callstack 0 + | (Multiple exs, bt1), e2 -> Multiple (e2 :: exs), bt1 + | e1, e2 -> Multiple [e2; e1], Printexc.get_callstack 0 + +module Backend = struct + type t = .. + + let show = ref true + + let printers : (Format.formatter -> t -> bool) list ref = ref [] + + let register_pp fn = + printers := fn :: !printers + + let pp f x = + if !show then ( + let rec aux = function + | [] -> Fmt.string f "?" + | pp :: pps -> if not (pp f x) then aux pps + in + aux !printers + ) else Fmt.string f "_" +end + +type err += X of Backend.t + +let () = + register_pp (fun f -> function + | Multiple_io errs -> Fmt.pf f "Multiple_io@\n%a" (Fmt.(list ~sep:cut) pp_with_bt) errs; true + | X ex -> Backend.pp f ex; true + | _ -> false + ) diff --git a/lib_eio/core/switch.ml b/lib_eio/core/switch.ml index 475496ffc..1b62a9288 100644 --- a/lib_eio/core/switch.ml +++ b/lib_eio/core/switch.ml @@ -167,6 +167,14 @@ let run_in t fn = | () -> Cancel.move_fiber_to old_cc ctx; | exception ex -> Cancel.move_fiber_to old_cc ctx; raise ex +exception Release_error of string * exn + +let () = + Printexc.register_printer (function + | Release_error (msg, ex) -> Some (Fmt.str "@[%s@,while handling %a@]" msg Exn.pp ex) + | _ -> None + ) + let on_release_full t fn = if Domain.self () = t.cancel.domain then ( match t.cancel.state with @@ -174,11 +182,15 @@ let on_release_full t fn = | Finished -> match Cancel.protect fn with | () -> invalid_arg "Switch finished!" - | exception ex -> raise (Exn.Multiple [ex; Invalid_argument "Switch finished!"]) + | exception ex -> + let bt = Printexc.get_raw_backtrace () in + Printexc.raise_with_backtrace (Release_error ("Switch finished!", ex)) bt ) else ( match Cancel.protect fn with | () -> invalid_arg "Switch accessed from wrong domain!" - | exception ex -> raise (Exn.Multiple [ex; Invalid_argument "Switch accessed from wrong domain!"]) + | exception ex -> + let bt = Printexc.get_raw_backtrace () in + Printexc.raise_with_backtrace (Release_error ("Switch accessed from wrong domain!", ex)) bt ) let on_release t fn = diff --git a/lib_eio/eio.ml b/lib_eio/eio.ml index be9d97915..829506c13 100644 --- a/lib_eio/eio.ml +++ b/lib_eio/eio.ml @@ -56,3 +56,5 @@ module Stdenv = struct let cwd (t : ) = t#cwd let debug (t : ) = t#debug end + +exception Io = Exn.Io diff --git a/lib_eio/eio.mli b/lib_eio/eio.mli index e46e2177e..39747d596 100644 --- a/lib_eio/eio.mli +++ b/lib_eio/eio.mli @@ -251,6 +251,8 @@ end (** {1 Errors and Debugging} *) +exception Io of Exn.err * Exn.context + val traceln : ?__POS__:string * int * int * int -> ('a, Format.formatter, unit, unit) format4 -> 'a @@ -273,7 +275,7 @@ val traceln : ]} @param __POS__ Display [__POS__] as the location of the [traceln] call. *) -(** Reporting multiple failures at once. *) +(** Eio exceptions. *) module Exn = Eio__core.Exn (** {1 Provider API for OS schedulers} *) diff --git a/lib_eio/fs.ml b/lib_eio/fs.ml index 8b5b63eef..0f8410927 100644 --- a/lib_eio/fs.ml +++ b/lib_eio/fs.ml @@ -5,10 +5,30 @@ module Unix_perm = File.Unix_perm [@@deprecated "Moved to File.Unix_perm"] type path = string -exception Already_exists of path * exn -exception Not_found of path * exn -exception Permission_denied of path * exn -exception File_too_large of path * exn +type error = + | Already_exists of Exn.Backend.t + | Not_found of Exn.Backend.t + | Permission_denied of Exn.Backend.t + | File_too_large + +type Exn.err += E of error + +let err e = + Exn.create (E e) + +let () = + Exn.register_pp (fun f -> function + | E e -> + Fmt.string f "Fs "; + begin match e with + | Already_exists e -> Fmt.pf f "Already_exists %a" Exn.Backend.pp e + | Not_found e -> Fmt.pf f "Not_found %a" Exn.Backend.pp e + | Permission_denied e -> Fmt.pf f "Permission_denied %a" Exn.Backend.pp e + | File_too_large -> Fmt.pf f "File_too_large" + end; + true + | _ -> false + ) (** When to create a new file. *) type create = [ diff --git a/lib_eio/mock/eio_mock.ml b/lib_eio/mock/eio_mock.ml index 7e6875887..c66ad9233 100644 --- a/lib_eio/mock/eio_mock.ml +++ b/lib_eio/mock/eio_mock.ml @@ -4,3 +4,9 @@ module Flow = Flow module Net = Net module Clock = Clock module Backend = Backend + +type Eio.Exn.Backend.t += Simulated_failure +let () = Eio.Exn.Backend.register_pp (fun f -> function + | Simulated_failure -> Fmt.string f "Simulated_failure"; true + | _ -> false + ) diff --git a/lib_eio/mock/eio_mock.mli b/lib_eio/mock/eio_mock.mli index 4424bb586..9cde0098d 100644 --- a/lib_eio/mock/eio_mock.mli +++ b/lib_eio/mock/eio_mock.mli @@ -165,3 +165,8 @@ module Clock = Clock to avoid a dependency on eio_main. *) module Backend = Backend + +(** {2 Mock errors} *) + +type Eio.Exn.Backend.t += Simulated_failure +(** A fake error code you can use for simulated faults. *) diff --git a/lib_eio/net.ml b/lib_eio/net.ml index 6094eed41..347db79f0 100644 --- a/lib_eio/net.ml +++ b/lib_eio/net.ml @@ -1,8 +1,29 @@ -exception Connection_reset of exn -(** This is a wrapper for EPIPE, ECONNRESET and similar errors. - It indicates that the flow has failed, and data may have been lost. *) - -exception Connection_failure of exn +type connection_failure = + | Refused of Exn.Backend.t + | No_matching_addresses + | Timeout + +type error = + | Connection_reset of Exn.Backend.t + | Connection_failure of connection_failure + +type Exn.err += E of error + +let err e = Exn.create (E e) + +let () = + Exn.register_pp (fun f -> function + | E e -> + Fmt.string f "Net "; + begin match e with + | Connection_reset e -> Fmt.pf f "Connection_reset %a" Exn.Backend.pp e + | Connection_failure Refused e -> Fmt.pf f "Connection_failure Refused %a" Exn.Backend.pp e + | Connection_failure Timeout -> Fmt.pf f "Connection_failure Timeout" + | Connection_failure No_matching_addresses -> Fmt.pf f "Connection_failure No_matching_addresses" + end; + true + | _ -> false + ) module Ipaddr = struct type 'a t = string (* = [Unix.inet_addr], but avoid a Unix dependency here *) @@ -161,7 +182,7 @@ let accept_fork ~sw (t : #listening_socket) ~on_error handle = | x -> Flow.close flow; x | exception ex -> Flow.close flow; - on_error ex + on_error (Exn.add_context ex "handling connection from %a" Sockaddr.pp addr) ) ) @@ -192,7 +213,12 @@ class virtual t = object end let listen ?(reuse_addr=false) ?(reuse_port=false) ~backlog ~sw (t:#t) = t#listen ~reuse_addr ~reuse_port ~backlog ~sw -let connect ~sw (t:#t) = t#connect ~sw + +let connect ~sw (t:#t) addr = + try t#connect ~sw addr + with Exn.Io _ as ex -> + let bt = Printexc.get_raw_backtrace () in + Exn.reraise_with_context ex bt "connecting to %a" Sockaddr.pp addr let datagram_socket ?(reuse_addr=false) ?(reuse_port=false) ~sw (t:#t) addr = let addr = (addr :> [Sockaddr.datagram | `UdpV4 | `UdpV6]) in @@ -220,21 +246,24 @@ let close = Flow.close let with_tcp_connect ?(timeout=Time.Timeout.none) ~host ~service t f = Switch.run @@ fun sw -> - let rec aux = function - | [] -> raise (Connection_failure (Failure (Fmt.str "No TCP addresses for %S" host))) - | addr :: addrs -> - match Time.Timeout.run_exn timeout (fun () -> connect ~sw t addr) with - | conn -> f conn - | exception (Time.Timeout | Connection_failure _) when addrs <> [] -> - aux addrs - | exception (Connection_failure _ as ex) -> - raise ex - | exception (Time.Timeout as ex) -> - raise (Connection_failure ex) - in - getaddrinfo_stream ~service t host - |> List.filter_map (function - | `Tcp _ as x -> Some x - | `Unix _ -> None - ) - |> aux + match + let rec aux = function + | [] -> raise @@ err (Connection_failure No_matching_addresses) + | addr :: addrs -> + try Time.Timeout.run_exn timeout (fun () -> connect ~sw t addr) with + | Time.Timeout | Exn.Io _ when addrs <> [] -> + aux addrs + | Time.Timeout -> + raise @@ err (Connection_failure Timeout) + in + getaddrinfo_stream ~service t host + |> List.filter_map (function + | `Tcp _ as x -> Some x + | `Unix _ -> None + ) + |> aux + with + | conn -> f conn + | exception (Exn.Io _ as ex) -> + let bt = Printexc.get_raw_backtrace () in + Exn.reraise_with_context ex bt "connecting to %S:%s" host service diff --git a/lib_eio/net.mli b/lib_eio/net.mli index eab8cf6ae..a91dd4ece 100644 --- a/lib_eio/net.mli +++ b/lib_eio/net.mli @@ -11,8 +11,21 @@ ]} *) -exception Connection_reset of exn -exception Connection_failure of exn +type connection_failure = + | Refused of Exn.Backend.t + | No_matching_addresses + | Timeout + +type error = + | Connection_reset of Exn.Backend.t + (** This is a wrapper for epipe, econnreset and similar errors. + It indicates that the flow has failed, and data may have been lost. *) + | Connection_failure of connection_failure + +type Exn.err += E of error + +val err : error -> exn +(** [err e] is [Eio.Exn.create (Net e)] *) (** IP addresses. *) module Ipaddr : sig @@ -120,9 +133,7 @@ end val connect : sw:Switch.t -> #t -> Sockaddr.stream -> (** [connect ~sw t addr] is a new socket connected to remote address [addr]. - The new socket will be closed when [sw] finishes, unless closed manually first. - - @raise Connection_failure if connection couldn't be established. *) + The new socket will be closed when [sw] finishes, unless closed manually first. *) val with_tcp_connect : ?timeout:Time.Timeout.t -> diff --git a/lib_eio/path.ml b/lib_eio/path.ml index 18d1fb197..045ad0f54 100644 --- a/lib_eio/path.ml +++ b/lib_eio/path.ml @@ -10,11 +10,35 @@ let ( / ) (dir, p1) p2 = let pp f ((t:#Fs.dir), p) = Fmt.pf f "<%t:%s>" t#pp (String.escaped p) -let open_in ~sw ((t:#Fs.dir), path) = t#open_in ~sw path -let open_out ~sw ?(append=false) ~create ((t:#Fs.dir), path) = t#open_out ~sw ~append ~create path -let open_dir ~sw ((t:#Fs.dir), path) = (t#open_dir ~sw path, "") -let mkdir ~perm ((t:#Fs.dir), path) = t#mkdir ~perm path -let read_dir ((t:#Fs.dir), path) = List.sort String.compare (t#read_dir path) +let open_in ~sw ((t:#Fs.dir), path) = + try t#open_in ~sw path + with Exn.Io _ as ex -> + let bt = Printexc.get_raw_backtrace () in + Exn.reraise_with_context ex bt "opening %a" pp (t, path) + +let open_out ~sw ?(append=false) ~create ((t:#Fs.dir), path) = + try t#open_out ~sw ~append ~create path + with Exn.Io _ as ex -> + let bt = Printexc.get_raw_backtrace () in + Exn.reraise_with_context ex bt "opening %a" pp (t, path) + +let open_dir ~sw ((t:#Fs.dir), path) = + try (t#open_dir ~sw path, "") + with Exn.Io _ as ex -> + let bt = Printexc.get_raw_backtrace () in + Exn.reraise_with_context ex bt "opening directory %a" pp (t, path) + +let mkdir ~perm ((t:#Fs.dir), path) = + try t#mkdir ~perm path + with Exn.Io _ as ex -> + let bt = Printexc.get_raw_backtrace () in + Exn.reraise_with_context ex bt "creating directory %a" pp (t, path) + +let read_dir ((t:#Fs.dir), path) = + try List.sort String.compare (t#read_dir path) + with Exn.Io _ as ex -> + let bt = Printexc.get_raw_backtrace () in + Exn.reraise_with_context ex bt "reading directory %a" pp (t, path) let with_open_in path fn = Switch.run @@ fun sw -> fn (open_in ~sw path) @@ -32,23 +56,40 @@ let with_lines path fn = let load (t, path) = with_open_in (t, path) @@ fun flow -> - let size = File.size flow in - if Optint.Int63.(compare size (of_int Sys.max_string_length)) = 1 then - raise (Fs.File_too_large - (path, Invalid_argument "can't represent a string that long")); - let buf = Cstruct.create (Optint.Int63.to_int size) in - let rec loop buf got = - match Flow.single_read flow buf with - | n -> loop (Cstruct.shift buf n) (n + got) - | exception End_of_file -> got - in - let got = loop buf 0 in - Cstruct.to_string ~len:got buf + try + let size = File.size flow in + if Optint.Int63.(compare size (of_int Sys.max_string_length)) = 1 then + raise @@ Fs.err File_too_large; + let buf = Cstruct.create (Optint.Int63.to_int size) in + let rec loop buf got = + match Flow.single_read flow buf with + | n -> loop (Cstruct.shift buf n) (n + got) + | exception End_of_file -> got + in + let got = loop buf 0 in + Cstruct.to_string ~len:got buf + with Exn.Io _ as ex -> + let bt = Printexc.get_raw_backtrace () in + Exn.reraise_with_context ex bt "loading %a" pp (t, path) let save ?append ~create path data = with_open_out ?append ~create path @@ fun flow -> Flow.copy_string data flow -let unlink ((t:#Fs.dir), path) = t#unlink path -let rmdir ((t:#Fs.dir), path) = t#rmdir path -let rename ((t1:#Fs.dir), old_path) (t2, new_path) = t1#rename old_path (t2 :> Fs.dir) new_path +let unlink ((t:#Fs.dir), path) = + try t#unlink path + with Exn.Io _ as ex -> + let bt = Printexc.get_raw_backtrace () in + Exn.reraise_with_context ex bt "removing file %a" pp (t, path) + +let rmdir ((t:#Fs.dir), path) = + try t#rmdir path + with Exn.Io _ as ex -> + let bt = Printexc.get_raw_backtrace () in + Exn.reraise_with_context ex bt "removing directory %a" pp (t, path) + +let rename ((t1:#Fs.dir), old_path) (t2, new_path) = + try t1#rename old_path (t2 :> Fs.dir) new_path + with Exn.Io _ as ex -> + let bt = Printexc.get_raw_backtrace () in + Exn.reraise_with_context ex bt "renaming %a to %a" pp (t1, old_path) pp (t2, new_path) diff --git a/lib_eio/unix/eio_unix.ml b/lib_eio/unix/eio_unix.ml index 113a277dc..214b892e8 100644 --- a/lib_eio/unix/eio_unix.ml +++ b/lib_eio/unix/eio_unix.ml @@ -1,3 +1,10 @@ +type Eio.Exn.Backend.t += Unix_error of Unix.error * string * string +let () = + Eio.Exn.Backend.register_pp (fun f -> function + | Unix_error (code, name, arg) -> Fmt.pf f "Unix_error (%s, %S, %S)" (Unix.error_message code) name arg; true + | _ -> false + ) + type unix_fd = < unix_fd : [`Peek | `Take] -> Unix.file_descr; > diff --git a/lib_eio/unix/eio_unix.mli b/lib_eio/unix/eio_unix.mli index 8e2135936..0981f9a16 100644 --- a/lib_eio/unix/eio_unix.mli +++ b/lib_eio/unix/eio_unix.mli @@ -6,6 +6,9 @@ open Eio.Std +type Eio.Exn.Backend.t += Unix_error of Unix.error * string * string +(** Wrapper for embedding {!Unix.Unix_error} errors. *) + type unix_fd = < unix_fd : [`Peek | `Take] -> Unix.file_descr; > diff --git a/lib_eio_linux/eio_linux.ml b/lib_eio_linux/eio_linux.ml index 9ffa440fd..df639be5c 100644 --- a/lib_eio_linux/eio_linux.ml +++ b/lib_eio_linux/eio_linux.ml @@ -33,13 +33,22 @@ type amount = Exactly of int | Upto of int let system_thread = Ctf.mint_id () -let wrap_errors path fn = - try fn () with - | Unix.Unix_error(Unix.EEXIST, _, _) as ex -> raise @@ Eio.Fs.Already_exists (path, ex) - | Unix.Unix_error(Unix.ENOENT, _, _) as ex -> raise @@ Eio.Fs.Not_found (path, ex) - | Unix.Unix_error(Unix.EXDEV, _, _) as ex -> raise @@ Eio.Fs.Permission_denied (path, ex) - | Eio.Fs.Permission_denied _ as ex -> raise @@ Eio.Fs.Permission_denied (path, ex) - | Eio.Fs.Not_found _ as ex -> raise @@ Eio.Fs.Not_found (path, ex) +let unclassified_error e = Eio.Exn.create (Eio.Exn.X e) + +let wrap_error code name arg = + let ex = Eio_unix.Unix_error (code, name, arg) in + match code with + | ECONNREFUSED -> Eio.Net.err (Connection_failure (Refused ex)) + | ECONNRESET | EPIPE -> Eio.Net.err (Connection_reset ex) + | _ -> unclassified_error ex + +let wrap_error_fs code name arg = + let e = Eio_unix.Unix_error (code, name, arg) in + match code with + | Unix.EEXIST -> Eio.Fs.err (Already_exists e) + | Unix.ENOENT -> Eio.Fs.err (Not_found e) + | Unix.EXDEV -> Eio.Fs.err (Permission_denied e) + | _ -> wrap_error code name arg type _ Effect.t += Close : Unix.file_descr -> int Effect.t @@ -72,7 +81,7 @@ module FD = struct let res = Effect.perform (Close fd) in Log.debug (fun l -> l "close: woken up"); if res < 0 then - raise (Unix.Unix_error (Uring.error_of_errno res, "close", string_of_int (Obj.magic fd : int))) + raise (wrap_error (Uring.error_of_errno res) "close" (string_of_int (Obj.magic fd : int))) ) let ensure_closed t = @@ -113,31 +122,33 @@ module FD = struct let fstat t = (* todo: use uring *) - let ust = Unix.LargeFile.fstat (get_exn "fstat" t) in - let st_kind : Eio.File.Stat.kind = - match ust.st_kind with - | Unix.S_REG -> `Regular_file - | Unix.S_DIR -> `Directory - | Unix.S_CHR -> `Character_special - | Unix.S_BLK -> `Block_device - | Unix.S_LNK -> `Symbolic_link - | Unix.S_FIFO -> `Fifo - | Unix.S_SOCK -> `Socket - in - Eio.File.Stat.{ - dev = ust.st_dev |> Int64.of_int; - ino = ust.st_ino |> Int64.of_int; - kind = st_kind; - perm = ust.st_perm; - nlink = ust.st_nlink |> Int64.of_int; - uid = ust.st_uid |> Int64.of_int; - gid = ust.st_gid |> Int64.of_int; - rdev = ust.st_rdev |> Int64.of_int; - size = ust.st_size |> Optint.Int63.of_int64; - atime = ust.st_atime; - mtime = ust.st_mtime; - ctime = ust.st_ctime; - } + try + let ust = Unix.LargeFile.fstat (get_exn "fstat" t) in + let st_kind : Eio.File.Stat.kind = + match ust.st_kind with + | Unix.S_REG -> `Regular_file + | Unix.S_DIR -> `Directory + | Unix.S_CHR -> `Character_special + | Unix.S_BLK -> `Block_device + | Unix.S_LNK -> `Symbolic_link + | Unix.S_FIFO -> `Fifo + | Unix.S_SOCK -> `Socket + in + Eio.File.Stat.{ + dev = ust.st_dev |> Int64.of_int; + ino = ust.st_ino |> Int64.of_int; + kind = st_kind; + perm = ust.st_perm; + nlink = ust.st_nlink |> Int64.of_int; + uid = ust.st_uid |> Int64.of_int; + gid = ust.st_gid |> Int64.of_int; + rdev = ust.st_rdev |> Int64.of_int; + size = ust.st_size |> Optint.Int63.of_int64; + atime = ust.st_atime; + mtime = ust.st_mtime; + ctime = ust.st_ctime; + } + with Unix.Unix_error (code, name, arg) -> raise @@ wrap_error_fs code name arg end type _ Eio.Generic.ty += FD : FD.t Eio.Generic.ty @@ -253,7 +264,7 @@ let cancel job = ) else if res = -114 then ( Log.debug (fun f -> f "Cancel returned EALREADY - operation cancelled while already in progress") ) else if res <> 0 then ( - raise (Unix.Unix_error (Uring.error_of_errno res, "cancel", "")) + raise (unclassified_error (Eio_unix.Unix_error (Uring.error_of_errno res, "cancel", ""))) ) (* Cancellation @@ -674,7 +685,7 @@ module Low_level = struct let noop () = let result = enter enqueue_noop in Log.debug (fun l -> l "noop returned"); - if result <> 0 then raise (Unix.Unix_error (Uring.error_of_errno result, "noop", "")) + if result <> 0 then raise (unclassified_error (Eio_unix.Unix_error (Uring.error_of_errno result, "noop", ""))) type _ Effect.t += Sleep_until : Mtime.t -> unit Effect.t let sleep_until d = @@ -682,22 +693,18 @@ module Low_level = struct type _ Effect.t += ERead : (Optint.Int63.t option * FD.t * Uring.Region.chunk * amount) -> int Effect.t - let wrap_connection_failed = function - | Unix.Unix_error ((ECONNRESET | EPIPE), _, _) as ex -> Eio.Net.Connection_reset ex - | ex -> ex - let read_exactly ?file_offset fd buf len = let res = Effect.perform (ERead (file_offset, fd, buf, Exactly len)) in Log.debug (fun l -> l "read_exactly: woken up after read"); if res < 0 then ( - raise (wrap_connection_failed (Unix.Unix_error (Uring.error_of_errno res, "read_exactly", ""))) + raise @@ wrap_error (Uring.error_of_errno res) "read_exactly" "" ) let read_upto ?file_offset fd buf len = let res = Effect.perform (ERead (file_offset, fd, buf, Upto len)) in Log.debug (fun l -> l "read_upto: woken up after read"); if res < 0 then ( - raise (wrap_connection_failed (Unix.Unix_error (Uring.error_of_errno res, "read_upto", ""))) + raise @@ wrap_error (Uring.error_of_errno res) "read_upto" "" ) else ( res ) @@ -706,7 +713,7 @@ module Low_level = struct let res = enter (enqueue_readv (file_offset, fd, bufs)) in Log.debug (fun l -> l "readv: woken up after read"); if res < 0 then ( - raise (wrap_connection_failed (Unix.Unix_error (Uring.error_of_errno res, "readv", ""))) + raise @@ wrap_error (Uring.error_of_errno res) "readv" "" ) else if res = 0 then ( raise End_of_file ) else ( @@ -717,7 +724,7 @@ module Low_level = struct let res = enter (enqueue_writev (file_offset, fd, bufs)) in Log.debug (fun l -> l "writev: woken up after write"); if res < 0 then ( - raise (wrap_connection_failed (Unix.Unix_error (Uring.error_of_errno res, "writev", ""))) + raise @@ wrap_error (Uring.error_of_errno res) "writev" "" ) else ( res ) @@ -740,14 +747,14 @@ module Low_level = struct let res = enter (enqueue_poll_add fd (Uring.Poll_mask.(pollin + pollerr))) in Log.debug (fun l -> l "await_readable: woken up"); if res < 0 then ( - raise (Unix.Unix_error (Uring.error_of_errno res, "await_readable", "")) + raise (unclassified_error (Eio_unix.Unix_error (Uring.error_of_errno res, "await_readable", ""))) ) let await_writable fd = let res = enter (enqueue_poll_add fd (Uring.Poll_mask.(pollout + pollerr))) in Log.debug (fun l -> l "await_writable: woken up"); if res < 0 then ( - raise (Unix.Unix_error (Uring.error_of_errno res, "await_writable", "")) + raise (unclassified_error (Eio_unix.Unix_error (Uring.error_of_errno res, "await_writable", ""))) ) type _ Effect.t += EWrite : (Optint.Int63.t option * FD.t * Uring.Region.chunk * amount) -> int Effect.t @@ -756,7 +763,7 @@ module Low_level = struct let res = Effect.perform (EWrite (file_offset, fd, buf, Exactly len)) in Log.debug (fun l -> l "write: woken up after write"); if res < 0 then ( - raise (wrap_connection_failed (Unix.Unix_error (Uring.error_of_errno res, "write", ""))) + raise @@ wrap_error (Uring.error_of_errno res) "write" "" ) type _ Effect.t += Alloc : Uring.Region.chunk option Effect.t @@ -773,21 +780,25 @@ module Low_level = struct Log.debug (fun l -> l "splice returned"); if res > 0 then res else if res = 0 then raise End_of_file - else raise (wrap_connection_failed (Unix.Unix_error (Uring.error_of_errno res, "splice", ""))) + else raise @@ wrap_error (Uring.error_of_errno res) "splice" "" let connect fd addr = let res = enter (enqueue_connect fd addr) in Log.debug (fun l -> l "connect returned"); if res < 0 then ( - let ex = Unix.Unix_error (Uring.error_of_errno res, "connect", "") in - raise (Eio.Net.Connection_failure ex) + let ex = + match addr with + | ADDR_UNIX _ -> wrap_error_fs (Uring.error_of_errno res) "connect" "" + | ADDR_INET _ -> wrap_error (Uring.error_of_errno res) "connect" "" + in + raise ex ) let send_msg fd ?(fds=[]) ?dst buf = let res = enter (enqueue_send_msg fd ~fds ~dst buf) in Log.debug (fun l -> l "send_msg returned"); if res < 0 then ( - raise (wrap_connection_failed (Unix.Unix_error (Uring.error_of_errno res, "send_msg", ""))) + raise @@ wrap_error (Uring.error_of_errno res) "send_msg" "" ) let recv_msg fd buf = @@ -796,7 +807,7 @@ module Low_level = struct let res = enter (enqueue_recv_msg fd msghdr) in Log.debug (fun l -> l "recv_msg returned"); if res < 0 then ( - raise (wrap_connection_failed (Unix.Unix_error (Uring.error_of_errno res, "recv_msg", ""))) + raise @@ wrap_error (Uring.error_of_errno res) "recv_msg" "" ); addr, res @@ -806,7 +817,7 @@ module Low_level = struct let res = enter (enqueue_recv_msg fd msghdr) in Log.debug (fun l -> l "recv_msg returned"); if res < 0 then ( - raise (wrap_connection_failed (Unix.Unix_error (Uring.error_of_errno res, "recv_msg", ""))) + raise @@ wrap_error (Uring.error_of_errno res) "recv_msg" "" ); let fds = Uring.Msghdr.get_fds msghdr @@ -822,17 +833,12 @@ module Low_level = struct | None -> fallback () - let openfile ~sw path flags mode = - let fd = Unix.openfile path flags mode in - FD.of_unix ~sw ~seekable:(FD.is_seekable fd) ~close_unix:true fd - let openat2 ~sw ?seekable ~access ~flags ~perm ~resolve ?dir path = - wrap_errors path @@ fun () -> let res = enter (enqueue_openat2 (access, flags, perm, resolve, dir, path)) in Log.debug (fun l -> l "openat2 returned"); if res < 0 then ( Switch.check sw; (* If cancelled, report that instead. *) - raise @@ Unix.Unix_error (Uring.error_of_errno res, "openat2", "") + raise @@ wrap_error_fs (Uring.error_of_errno res) "openat2" "" ); let fd : Unix.file_descr = Obj.magic res in let seekable = @@ -877,7 +883,6 @@ module Low_level = struct match dir with | FD d when dir_path = "." -> d | _ -> - wrap_errors path @@ fun () -> openat ~sw ~seekable:false dir dir_path ~access:`R ~flags:Uring.Open_flags.(cloexec + path + directory) @@ -889,26 +894,27 @@ module Low_level = struct let mkdir_beneath ~perm dir path = (* [mkdir] is really an operation on [path]'s parent. Get a reference to that first: *) with_parent_dir dir path @@ fun parent leaf -> - wrap_errors path @@ fun () -> - eio_mkdirat (FD.get_exn "mkdirat" parent) leaf perm + try eio_mkdirat (FD.get_exn "mkdirat" parent) leaf perm + with Unix.Unix_error (code, name, arg) -> raise @@ wrap_error_fs code name arg let unlink ~rmdir dir path = (* [unlink] is really an operation on [path]'s parent. Get a reference to that first: *) with_parent_dir dir path @@ fun parent leaf -> - wrap_errors path @@ fun () -> let res = enter (enqueue_unlink (rmdir, parent, leaf)) in - if res <> 0 then raise @@ Unix.Unix_error (Uring.error_of_errno res, "unlinkat", "") + if res <> 0 then raise @@ wrap_error_fs (Uring.error_of_errno res) "unlinkat" "" let rename old_dir old_path new_dir new_path = with_parent_dir old_dir old_path @@ fun old_parent old_leaf -> with_parent_dir new_dir new_path @@ fun new_parent new_leaf -> - wrap_errors old_path @@ fun () -> - eio_renameat - (FD.get_exn "renameat-old" old_parent) old_leaf - (FD.get_exn "renameat-new" new_parent) new_leaf + try + eio_renameat + (FD.get_exn "renameat-old" old_parent) old_leaf + (FD.get_exn "renameat-new" new_parent) new_leaf + with Unix.Unix_error (code, name, arg) -> raise @@ wrap_error_fs code name arg let shutdown socket command = - Unix.shutdown (FD.get_exn "shutdown" socket) command + try Unix.shutdown (FD.get_exn "shutdown" socket) command + with Unix.Unix_error (code, name, arg) -> raise @@ wrap_error code name arg let accept ~sw fd = Ctf.label "accept"; @@ -916,7 +922,7 @@ module Low_level = struct let res = enter (enqueue_accept fd client_addr) in Log.debug (fun l -> l "accept returned"); if res < 0 then ( - raise (Unix.Unix_error (Uring.error_of_errno res, "accept", "")) + raise @@ wrap_error (Uring.error_of_errno res) "accept" "" ) else ( let unix : Unix.file_descr = Obj.magic res in let client = FD.of_unix ~sw ~seekable:false ~close_unix:true unix in @@ -997,8 +1003,7 @@ let _fast_copy_try_splice src dst = done with | End_of_file -> () - | Unix.Unix_error (Unix.EAGAIN, "splice", _) -> fast_copy src dst - | Unix.Unix_error (Unix.EINVAL, "splice", _) -> fast_copy src dst + | Eio.Exn.Io (Eio.Exn.X Eio_unix.Unix_error ((EAGAIN | EINVAL), "splice", _), _) -> fast_copy src dst (* XXX workaround for issue #319, PR #327 *) let fast_copy_try_splice src dst = fast_copy src dst @@ -1153,6 +1158,7 @@ let net = object | Unix.{ st_kind = S_SOCK; _ } -> Unix.unlink path | _ -> () | exception Unix.Unix_error (Unix.ENOENT, _, _) -> () + | exception Unix.Unix_error (code, name, arg) -> raise @@ wrap_error code name arg ); Unix.SOCK_STREAM, Unix.ADDR_UNIX path | `Tcp (host, port) -> diff --git a/lib_eio_linux/eio_linux.mli b/lib_eio_linux/eio_linux.mli index 659797e9c..8eacc61dc 100644 --- a/lib_eio_linux/eio_linux.mli +++ b/lib_eio_linux/eio_linux.mli @@ -136,9 +136,6 @@ module Low_level : sig (** {1 File manipulation functions} *) - val openfile : sw:Switch.t -> string -> Unix.open_flag list -> int -> FD.t - (** Like {!Unix.open_file}. *) - val openat2 : sw:Switch.t -> ?seekable:bool -> diff --git a/lib_eio_linux/tests/basic_eio_linux.ml b/lib_eio_linux/tests/basic_eio_linux.ml index 335d2fbd8..c1ff8b175 100644 --- a/lib_eio_linux/tests/basic_eio_linux.ml +++ b/lib_eio_linux/tests/basic_eio_linux.ml @@ -13,7 +13,14 @@ let () = setup_log (Some Logs.Debug); Eio_linux.run @@ fun _stdenv -> Switch.run @@ fun sw -> - let fd = Unix.handle_unix_error (openfile ~sw "test.txt" Unix.[O_RDONLY]) 0 in + let fd = + openat2 "test.txt" + ~sw + ~access:`R + ~perm:0 + ~flags:Uring.Open_flags.empty + ~resolve:Uring.Resolve.empty +in let buf = alloc_fixed_or_wait () in let _ = read_exactly fd buf 5 in print_endline (Uring.Region.to_string ~len:5 buf); diff --git a/lib_eio_linux/tests/eurcp_lib.ml b/lib_eio_linux/tests/eurcp_lib.ml index cf6218e61..aba0cd739 100644 --- a/lib_eio_linux/tests/eurcp_lib.ml +++ b/lib_eio_linux/tests/eurcp_lib.ml @@ -28,9 +28,23 @@ let copy_file infd outfd insize block_size = let run_cp block_size queue_depth infile outfile () = Eio_linux.run ~queue_depth ~n_blocks:queue_depth ~block_size @@ fun _stdenv -> Switch.run @@ fun sw -> - let open Unix in - let infd = U.openfile ~sw infile [O_RDONLY] 0 in - let outfd = U.openfile ~sw outfile [O_WRONLY; O_CREAT; O_TRUNC] 0o644 in + let infd = + U.openat2 infile + ~sw ~seekable:true + ~access:`R + ~flags:Uring.Open_flags.empty + ~perm:0 + ~resolve:Uring.Resolve.empty + in + let outfd = + U.openat2 outfile + ~sw + ~seekable:true + ~access:`RW + ~flags:Uring.Open_flags.(creat + trunc) + ~resolve:Uring.Resolve.empty + ~perm:0o644 + in let insize = (U.fstat infd).size in Logs.debug (fun l -> l "eurcp: %s -> %s size %a queue %d bs %d" infile diff --git a/lib_eio_luv/eio_luv.ml b/lib_eio_luv/eio_luv.ml index 738e7aa23..82beaaab6 100644 --- a/lib_eio_luv/eio_luv.ml +++ b/lib_eio_luv/eio_luv.ml @@ -27,34 +27,39 @@ module Lf_queue = Eio_utils.Lf_queue (* SIGPIPE makes no sense in a modern application. *) let () = Sys.(set_signal sigpipe Signal_ignore) -exception Luv_error of Luv.Error.t +type Eio.Exn.Backend.t += + | Luv_error of Luv.Error.t + | Outside_sandbox of string * string + | Absolute_path + +let unclassified_error e = Eio.Exn.create (Eio.Exn.X e) let () = - Printexc.register_printer @@ function - | Luv_error e -> Some (Printf.sprintf "Eio_luv.Luv_error(%s) (* %s *)" (Luv.Error.err_name e) (Luv.Error.strerror e)) - | _ -> None + Eio.Exn.Backend.register_pp (fun f -> function + | Luv_error e -> Fmt.pf f "Eio_luv.Luv_error(%s) (* %s *)" (Luv.Error.err_name e) (Luv.Error.strerror e); true + | Outside_sandbox (path, dir) -> Fmt.pf f "Outside_sandbox (%S, %S)" path dir; true + | Absolute_path -> Fmt.pf f "Absolute_path"; true + | _ -> false + ) -let wrap_error ~path e = - let ex = Luv_error e in - match e with - | `EEXIST -> Eio.Fs.Already_exists (path, ex) - | `ENOENT -> Eio.Fs.Not_found (path, ex) - | _ -> ex +let wrap_error = function + | `ECONNREFUSED as e -> Eio.Net.err (Connection_failure (Refused (Luv_error e))) + | `ECONNRESET | `EPIPE as e -> Eio.Net.err (Connection_reset (Luv_error e)) + | e -> unclassified_error (Luv_error e) -let wrap_flow_error e = - let ex = Luv_error e in +let wrap_error_fs e = match e with - | `ECONNRESET - | `EPIPE -> Eio.Net.Connection_reset ex - | _ -> ex + | `EEXIST -> Eio.Fs.err (Already_exists (Luv_error e)) + | `ENOENT -> Eio.Fs.err (Not_found (Luv_error e)) + | e -> wrap_error e let or_raise = function | Ok x -> x - | Error e -> raise (Luv_error e) + | Error e -> raise (wrap_error e) -let or_raise_path path = function +let or_raise_fs = function | Ok x -> x - | Error e -> raise (wrap_error ~path e) + | Error e -> raise (wrap_error_fs e) (* Luv can't handle buffers with more than 2^32-1 bytes, limit it to 31bit so we can also make sure 32bit archs don't overflow. @@ -180,8 +185,9 @@ end = struct if List.mem `READABLE es then apply_all events.read (fun k -> enqueue_and_remove t enqueue_thread k ()); if List.mem `WRITABLE es then apply_all events.write (fun k -> enqueue_and_remove t enqueue_thread k ()); | Error e -> - apply_all events.read (fun k -> enqueue_and_remove t enqueue_failed_thread k (Luv_error e)); - apply_all events.write (fun k -> enqueue_and_remove t enqueue_failed_thread k (Luv_error e)) + let e = unclassified_error (Luv_error e) in + apply_all events.read (fun k -> enqueue_and_remove t enqueue_failed_thread k e); + apply_all events.write (fun k -> enqueue_and_remove t enqueue_failed_thread k e) end; update t events and update t events = @@ -275,7 +281,6 @@ let unix_fstat fd = module Low_level = struct type 'a or_error = ('a, Luv.Error.t) result - exception Luv_error = Luv_error let or_raise = or_raise let get_loop () = @@ -333,7 +338,7 @@ module Low_level = struct begin match Luv.Handle.fileno fd with | Ok fd -> Poll.cancel_all t (Luv_unix.Os_fd.Fd.to_unix fd) | Error `EBADF -> () (* We don't have a Unix FD yet, so we can't be watching it. *) - | Error e -> raise (Luv_error e) + | Error e -> raise (unclassified_error (Luv_error e)) end; Luv.Handle.close fd (enqueue_thread t k) ) @@ -494,7 +499,7 @@ module Low_level = struct match await_with_cancel ~request (fun loop -> Luv.Random.random ~loop ~request buf) with | Ok x -> x | Error `EINTR -> fill buf - | Error x -> raise (Luv_error x) + | Error x -> raise @@ wrap_error x end module Stream = struct @@ -517,7 +522,7 @@ module Low_level = struct if len > 0 then len else read_into sock buf (* Luv uses a zero-length read to mean EINTR! *) | Error `EOF -> raise End_of_file - | Error x -> raise (wrap_flow_error x) + | Error x -> raise (wrap_error x) let rec skip_empty = function | empty :: xs when Luv.Buffer.size empty = 0 -> skip_empty xs @@ -532,7 +537,7 @@ module Low_level = struct ) in match err with - | Error e -> raise (wrap_flow_error e) + | Error e -> raise (wrap_error e) | Ok () -> match Luv.Buffer.drop bufs n |> skip_empty with | [] -> () @@ -547,7 +552,7 @@ module Low_level = struct let sock = Luv.Pipe.init ~loop:(get_loop ()) () |> or_raise |> Handle.of_luv ~sw in match await (fun _loop _fiber -> Luv.Pipe.connect (Handle.get "connect" sock) path) with | Ok () -> sock - | Error e -> raise (Eio.Net.Connection_failure (Luv_error e)) + | Error e -> raise @@ wrap_error_fs e let connect_tcp ~sw addr = let sock = Luv.TCP.init ~loop:(get_loop ()) () |> or_raise in @@ -560,7 +565,7 @@ module Low_level = struct Luv.Handle.close sock ignore; match Fiber_context.get_error k.fiber with | Some ex -> enqueue_failed_thread st k ex - | None -> enqueue_failed_thread st k (Eio.Net.Connection_failure (Luv_error e)) + | None -> enqueue_failed_thread st k (wrap_error e) ); Fiber_context.set_cancel_fn k.fiber (fun _ex -> match Luv.Handle.fileno sock with @@ -781,7 +786,7 @@ class virtual ['a] listening_socket ~backlog sock = object (self) match Luv.Stream.accept ~server:(Handle.get "accept" sock) ~client:(Handle.get "accept" client) with | Error e -> Handle.close client; - raise (Luv_error e) + raise (wrap_error e) | Ok () -> Switch.on_release sw (fun () -> Handle.ensure_closed client); let flow = (socket client :> ) in @@ -837,14 +842,14 @@ module Udp = struct match r with | Ok (buf', sockaddr, _recv_flags) -> `Udp (luv_ip_addr_to_eio sockaddr), Luv.Buffer.size buf' - | Error x -> raise (wrap_flow_error x) + | Error e -> raise (wrap_error e) let send t buf = function | `Udp (host, port) -> let bufs = cstructv_to_luv [ buf ] in match await (fun _loop _fiber -> Luv.UDP.send (Handle.get "send" t) bufs (luv_addr_of_eio host port)) with | Ok () -> () - | Error e -> raise (wrap_flow_error e) + | Error e -> raise (wrap_error e) end let udp_socket endp = object @@ -1038,36 +1043,32 @@ class dir ~label (dir_path : string) = object (self) (* Resolve a relative path to an absolute one, with no symlinks. @raise Eio.Fs.Permission_denied if it's outside of [dir_path]. *) - method private resolve ?display_path path = + method private resolve path = if closed then Fmt.invalid_arg "Attempt to use closed directory %S" dir_path; - let display_path = Option.value display_path ~default:path in if Filename.is_relative path then ( - let dir_path = File.realpath dir_path |> or_raise_path dir_path in - let full = File.realpath (Filename.concat dir_path path) |> or_raise_path path in + let dir_path = File.realpath dir_path |> or_raise_fs in + let full = File.realpath (Filename.concat dir_path path) |> or_raise_fs in let prefix_len = String.length dir_path + 1 in if String.length full >= prefix_len && String.sub full 0 prefix_len = dir_path ^ Filename.dir_sep then full else if full = dir_path then full else - raise (Eio.Fs.Permission_denied (display_path, Failure (Fmt.str "Path %S is outside of sandbox %S" full dir_path))) + raise @@ Eio.Fs.err (Permission_denied (Outside_sandbox (full, dir_path))) ) else ( - raise (Eio.Fs.Permission_denied (display_path, Failure (Fmt.str "Path %S is absolute" path))) + raise @@ Eio.Fs.err (Permission_denied Absolute_path) ) (* We want to create [path]. Check that the parent is in the sandbox. *) method private resolve_new path = let dir, leaf = Filename.dirname path, Filename.basename path in if leaf = ".." then Fmt.failwith "New path %S ends in '..'!" path - else match self#resolve dir with - | dir -> Filename.concat dir leaf - | exception Eio.Fs.Not_found (dir, ex) -> - raise (Eio.Fs.Not_found (Filename.concat dir leaf, ex)) - | exception Eio.Fs.Permission_denied (dir, ex) -> - raise (Eio.Fs.Permission_denied (Filename.concat dir leaf, ex)) + else + let dir = self#resolve dir in + Filename.concat dir leaf method open_in ~sw path = - let fd = File.open_ ~sw (self#resolve path) [`NOFOLLOW; `RDONLY] |> or_raise_path path in + let fd = File.open_ ~sw (self#resolve path) [`NOFOLLOW; `RDONLY] |> or_raise_fs in (flow fd :> ) method open_out ~sw ~append ~create path = @@ -1084,7 +1085,7 @@ class dir ~label (dir_path : string) = object (self) if create = `Never then self#resolve path else self#resolve_new path in - let fd = File.open_ ~sw real_path flags ~mode:[`NUMERIC mode] |> or_raise_path path in + let fd = File.open_ ~sw real_path flags ~mode:[`NUMERIC mode] |> or_raise_fs in (flow fd :> ) method open_dir ~sw path = @@ -1097,25 +1098,25 @@ class dir ~label (dir_path : string) = object (self) (* libuv doesn't seem to provide a race-free way to do this. *) method mkdir ~perm path = let real_path = self#resolve_new path in - File.mkdir ~mode:[`NUMERIC perm] real_path |> or_raise_path path + File.mkdir ~mode:[`NUMERIC perm] real_path |> or_raise_fs (* libuv doesn't seem to provide a race-free way to do this. *) method unlink path = let dir_path = Filename.dirname path in let leaf = Filename.basename path in - let real_dir_path = self#resolve ~display_path:path dir_path in - File.unlink (Filename.concat real_dir_path leaf) |> or_raise_path path + let real_dir_path = self#resolve dir_path in + File.unlink (Filename.concat real_dir_path leaf) |> or_raise_fs (* libuv doesn't seem to provide a race-free way to do this. *) method rmdir path = let dir_path = Filename.dirname path in let leaf = Filename.basename path in - let real_dir_path = self#resolve ~display_path:path dir_path in - File.rmdir (Filename.concat real_dir_path leaf) |> or_raise_path path + let real_dir_path = self#resolve dir_path in + File.rmdir (Filename.concat real_dir_path leaf) |> or_raise_fs method read_dir path = let path = self#resolve path in - File.readdir path |> or_raise_path path + File.readdir path |> or_raise_fs method rename old_path new_dir new_path = match dir_resolve_new new_dir with @@ -1123,7 +1124,7 @@ class dir ~label (dir_path : string) = object (self) | Some new_resolve_new -> let old_path = self#resolve old_path in let new_path = new_resolve_new new_path in - File.rename old_path new_path |> or_raise_path old_path + File.rename old_path new_path |> or_raise_fs method close = closed <- true @@ -1135,7 +1136,7 @@ let fs = object inherit dir ~label:"fs" "." (* No checks *) - method! private resolve ?display_path:_ path = path + method! private resolve path = path end let cwd = object @@ -1239,17 +1240,18 @@ let rec run : type a. (_ -> a) -> a = fun main -> ) | Eio_unix.Private.Get_monotonic_clock -> Some (fun k -> continue k mono_clock) | Eio_unix.Private.Socket_of_fd (sw, close_unix, fd) -> Some (fun k -> - try + match let fd = Low_level.Stream.of_unix fd in let sock = Luv.TCP.init ~loop () |> or_raise in let handle = Handle.of_luv ~sw ~close_unix sock in Luv.TCP.open_ sock fd |> or_raise; - continue k (socket handle :> Eio_unix.socket) - with Luv_error _ as ex -> - discontinue k ex + (socket handle :> Eio_unix.socket) + with + | sock -> continue k sock + | exception (Eio.Io _ as ex) -> discontinue k ex ) | Eio_unix.Private.Socketpair (sw, domain, ty, protocol) -> Some (fun k -> - try + match if domain <> Unix.PF_UNIX then failwith "Only PF_UNIX sockets are supported by libuv"; let ty = match ty with @@ -1265,9 +1267,10 @@ let rec run : type a. (_ -> a) -> a = fun main -> let h = Handle.of_luv ~sw ~close_unix:true sock in (socket h :> Eio_unix.socket) in - continue k (wrap a, wrap b) - with Luv_error _ as ex -> - discontinue k ex + (wrap a, wrap b) + with + | x -> continue k x + | exception (Eio.Io _ as ex) -> discontinue k ex ) | Eio_unix.Private.Pipe sw -> Some (fun k -> let r, w = Luv.Pipe.pipe ~read_flags:[] ~write_flags:[] () |> or_raise in diff --git a/lib_eio_luv/eio_luv.mli b/lib_eio_luv/eio_luv.mli index 63810bfe8..deb5fd8e4 100644 --- a/lib_eio_luv/eio_luv.mli +++ b/lib_eio_luv/eio_luv.mli @@ -7,11 +7,14 @@ open Eio.Std +type Eio.Exn.Backend.t += + | Luv_error of Luv.Error.t + | Outside_sandbox of string * string + | Absolute_path + module Low_level : sig type 'a or_error = ('a, Luv.Error.t) result - exception Luv_error of Luv.Error.t - val get_loop : unit -> Luv.Loop.t (** [get_loop ()] returns the current fiber's event loop. @@ -20,7 +23,7 @@ module Low_level : sig The wrapper functions in this file all do this for you. *) val or_raise : 'a or_error -> 'a - (** [or_raise (Error e)] raises [Luv_error e]. *) + (** [or_raise (Error e)] raises [Eio.Exn.Io] with [e]. *) val await_with_cancel : request:[< `File | `Addr_info | `Name_info | `Random | `Thread_pool ] Luv.Request.t -> diff --git a/tests/exn.md b/tests/exn.md new file mode 100644 index 000000000..e8bcacf58 --- /dev/null +++ b/tests/exn.md @@ -0,0 +1,85 @@ +# Setting up the environment + +```ocaml +# #require "eio.mock";; +``` + +Adjust this to test backtrace printing: +```ocaml +let () = Printexc.record_backtrace false +``` + +```ocaml +let non_io a = + try failwith a + with ex -> ex, Printexc.get_raw_backtrace () + +let not_found = + try raise @@ Eio.Fs.err (Not_found Eio_mock.Simulated_failure) + with ex -> + let bt = Printexc.get_raw_backtrace () in + let ex = Eio.Exn.add_context ex "opening file 'foo'" in + ex, bt + +let denied = + try raise @@ Eio.Fs.err (Permission_denied Eio_mock.Simulated_failure) + with ex -> + let bt = Printexc.get_raw_backtrace () in + let ex = Eio.Exn.add_context ex "saving file 'bar'" in + ex, bt + +let combine a b = + fst @@ Eio.Exn.combine a b +``` + +## Combining exceptions + +Combining regular exceptions: + +```ocaml +# raise @@ combine (non_io "a") (non_io "b");; +Exception: Multiple exceptions: +- Failure("a") +- Failure("b") +``` + +An IO error and a regular exception becomes a regular (non-IO) multiple exception: + +```ocaml +# raise @@ combine (non_io "a") not_found;; +Exception: +Multiple exceptions: +- Failure("a") +- Eio.Io Fs Not_found Simulated_failure, + opening file 'foo' +``` + +Combining IO exceptions produces another IO exception, +so that if you want to e.g. log all IO errors and continue then that still works: + +```ocaml +# Fmt.pr "@[%a@]@." Eio.Exn.pp (combine denied not_found);; +Eio.Io Multiple_io +- Fs Permission_denied Simulated_failure, saving file 'bar' +- Fs Not_found Simulated_failure, opening file 'foo' +- : unit = () +``` + +They form a tree, because the context information may be useful too: + +```ocaml +let combined = + let e = Eio.Exn.combine denied not_found in + let ex = Eio.Exn.add_context (fst e) "processing request" in + ex, snd e +``` + +```ocaml +# Fmt.pr "@[%a@]@." Eio.Exn.pp (combine combined not_found);; +Eio.Io Multiple_io +- Multiple_io + - Fs Permission_denied Simulated_failure, saving file 'bar' + - Fs Not_found Simulated_failure, opening file 'foo', processing request +- Fs Not_found Simulated_failure, opening file 'foo' +- : unit = () +``` diff --git a/tests/fiber.md b/tests/fiber.md index fc7c86d33..c4fbd00a4 100644 --- a/tests/fiber.md +++ b/tests/fiber.md @@ -75,9 +75,8 @@ Both crash - report both: (fun () -> failwith "a crashed") (fun () -> failwith "b crashed");; Exception: Multiple exceptions: -Failure("a crashed") -and -Failure("b crashed") +- Failure("a crashed") +- Failure("b crashed") ``` Cancelled before it can crash: diff --git a/tests/fs.md b/tests/fs.md index 9eafb0dca..63a1c7e72 100644 --- a/tests/fs.md +++ b/tests/fs.md @@ -10,13 +10,7 @@ module Path = Eio.Path -let () = - Printexc.register_printer (function - | Eio.Fs.Permission_denied (path, _) -> Some (Fmt.str "Eio.Fs.Permission_denied (%S, _)" path) - | Eio.Fs.Already_exists (path, _) -> Some (Fmt.str "Eio.Fs.Already_exists (%S, _)" path) - | Eio.Fs.Not_found (path, _) -> Some (Fmt.str "Eio.Fs.Not_found (%S, _)" path) - | _ -> None - ) +let () = Eio.Exn.Backend.show := false open Eio.Std @@ -29,37 +23,37 @@ let run (fn : Eio.Stdenv.t -> unit) = let try_read_file path = match Path.load path with | s -> traceln "read %a -> %S" Path.pp path s - | exception ex -> traceln "read %a -> %a" Path.pp path Fmt.exn ex + | exception ex -> traceln "@[%a@]" Eio.Exn.pp ex let try_write_file ~create ?append path content = match Path.save ~create ?append path content with | () -> traceln "write %a -> ok" Path.pp path - | exception ex -> traceln "write %a -> %a" Path.pp path Fmt.exn ex + | exception ex -> traceln "@[%a@]" Eio.Exn.pp ex let try_mkdir path = match Path.mkdir path ~perm:0o700 with | () -> traceln "mkdir %a -> ok" Path.pp path - | exception ex -> traceln "mkdir %a -> %a" Path.pp path Fmt.exn ex + | exception ex -> traceln "@[%a@]" Eio.Exn.pp ex let try_rename p1 p2 = match Path.rename p1 p2 with | () -> traceln "rename %a to %a -> ok" Path.pp p1 Path.pp p2 - | exception ex -> traceln "rename %a to %a -> %a" Path.pp p1 Path.pp p2 Fmt.exn ex + | exception ex -> traceln "@[%a@]" Eio.Exn.pp ex let try_read_dir path = match Path.read_dir path with | names -> traceln "read_dir %a -> %a" Path.pp path Fmt.Dump.(list string) names - | exception ex -> traceln "read_dir %a -> %a" Path.pp path Fmt.exn ex + | exception ex -> traceln "@[%a@]" Eio.Exn.pp ex let try_unlink path = match Path.unlink path with | () -> traceln "unlink %a -> ok" Path.pp path - | exception ex -> traceln "unlink %a -> %a" Path.pp path Fmt.exn ex + | exception ex -> traceln "@[%a@]" Eio.Exn.pp ex let try_rmdir path = match Path.rmdir path with | () -> traceln "rmdir %a -> ok" Path.pp path - | exception ex -> traceln "rmdir %a -> %a" Path.pp path Fmt.exn ex + | exception ex -> traceln "@[%a@]" Eio.Exn.pp ex let chdir path = traceln "chdir %S" path; @@ -97,7 +91,8 @@ Trying to use cwd to access a file outside of that subtree fails: let cwd = Eio.Stdenv.cwd env in Path.save ~create:(`Exclusive 0o666) (cwd / "../test-file") "my-data"; failwith "Should have failed";; -Exception: Eio.Fs.Permission_denied ("../test-file", _) +Exception: Eio.Io Fs Permission_denied _, + opening ``` Trying to use cwd to access an absolute path fails: @@ -106,7 +101,8 @@ Trying to use cwd to access an absolute path fails: let cwd = Eio.Stdenv.cwd env in Path.save ~create:(`Exclusive 0o666) (cwd / "/tmp/test-file") "my-data"; failwith "Should have failed";; -Exception: Eio.Fs.Permission_denied ("/tmp/test-file", _) +Exception: Eio.Io Fs Permission_denied _, + opening ``` # Creation modes @@ -118,7 +114,8 @@ Exclusive create fails if already exists: Path.save ~create:(`Exclusive 0o666) (cwd / "test-file") "first-write"; Path.save ~create:(`Exclusive 0o666) (cwd / "test-file") "first-write"; failwith "Should have failed";; -Exception: Eio.Fs.Already_exists ("test-file", _) +Exception: Eio.Io Fs Already_exists _, + opening ``` If-missing create succeeds if already exists: @@ -154,7 +151,8 @@ Error if no create and doesn't exist: let test_file = (cwd / "test-file") in Path.save ~create:`Never test_file "1st-write-original"; traceln "Got %S" @@ Path.load test_file;; -Exception: Eio.Fs.Not_found ("test-file", _) +Exception: Eio.Io Fs Not_found _, + opening ``` Appending to an existing file: @@ -206,10 +204,10 @@ Creating directories with nesting, symlinks, etc: ();; +mkdir -> ok +mkdir -> ok -+mkdir -> Eio.Fs.Permission_denied ("to-root/tmp/foo", _) -+mkdir -> Eio.Fs.Permission_denied ("../foo", _) -+mkdir -> Eio.Fs.Already_exists ("to-subdir", _) -+mkdir -> Eio.Fs.Not_found ("dangle/foo", _) ++Eio.Io Fs Permission_denied _, creating directory ++Eio.Io Fs Permission_denied _, creating directory ++Eio.Io Fs Already_exists _, creating directory ++Eio.Io Fs Not_found _, creating directory - : unit = () ``` @@ -236,11 +234,11 @@ You can remove a file using unlink: +read -> "data2" +unlink -> ok +unlink -> ok -+read -> Eio.Fs.Not_found ("file", _) -+read -> Eio.Fs.Not_found ("subdir/file2", _) ++Eio.Io Fs Not_found _, opening ++Eio.Io Fs Not_found _, opening +write -> ok +unlink -> ok -+read -> Eio.Fs.Not_found ("subdir/file2", _) ++Eio.Io Fs Not_found _, opening - : unit = () ``` @@ -254,10 +252,10 @@ Removing something that doesn't exist or is out of scope: try_unlink (cwd / "../foo"); try_unlink (cwd / "to-subdir/foo"); try_unlink (cwd / "to-root/foo");; -+unlink -> Eio.Fs.Not_found ("missing", _) -+unlink -> Eio.Fs.Permission_denied ("../foo", _) -+unlink -> Eio.Fs.Not_found ("to-subdir/foo", _) -+unlink -> Eio.Fs.Permission_denied ("to-root/foo", _) ++Eio.Io Fs Not_found _, removing file ++Eio.Io Fs Permission_denied _, removing file ++Eio.Io Fs Not_found _, removing file ++Eio.Io Fs Permission_denied _, removing file - : unit = () ``` @@ -286,11 +284,11 @@ Similar to `unlink`, but works on directories: +read_dir -> [] +rmdir -> ok +rmdir -> ok -+read_dir -> Eio.Fs.Not_found ("d1", _) -+read_dir -> Eio.Fs.Not_found ("subdir/d2", _) ++Eio.Io Fs Not_found _, reading directory ++Eio.Io Fs Not_found _, reading directory +mkdir -> ok +rmdir -> ok -+read_dir -> Eio.Fs.Not_found ("subdir/d3", _) ++Eio.Io Fs Not_found _, reading directory - : unit = () ``` @@ -304,10 +302,10 @@ Removing something that doesn't exist or is out of scope: try_rmdir (cwd / "../foo"); try_rmdir (cwd / "to-subdir/foo"); try_rmdir (cwd / "to-root/foo");; -+rmdir -> Eio.Fs.Not_found ("missing", _) -+rmdir -> Eio.Fs.Permission_denied ("../foo", _) -+rmdir -> Eio.Fs.Not_found ("to-subdir/foo", _) -+rmdir -> Eio.Fs.Permission_denied ("to-root/foo", _) ++Eio.Io Fs Not_found _, removing directory ++Eio.Io Fs Permission_denied _, removing directory ++Eio.Io Fs Not_found _, removing directory ++Eio.Io Fs Permission_denied _, removing directory - : unit = () ``` @@ -324,7 +322,7 @@ Create a sandbox, write a file with it, then read it from outside: try_mkdir (subdir / "../new-sandbox"); traceln "Got %S" @@ Path.load (cwd / "sandbox/test-file");; +mkdir -> ok -+mkdir -> Eio.Fs.Permission_denied ("../new-sandbox", _) ++Eio.Io Fs Permission_denied _, creating directory +Got "data" - : unit = () ``` @@ -349,8 +347,8 @@ Using `cwd` we can't access the parent, but using `fs` we can: Unix.rmdir "outside-cwd";; +mkdir -> ok +chdir "fs-test" -+mkdir -> Eio.Fs.Permission_denied ("../outside-cwd", _) -+write -> Eio.Fs.Permission_denied ("../test-file", _) ++Eio.Io Fs Permission_denied _, creating directory ++Eio.Io Fs Permission_denied _, opening +mkdir -> ok +write -> ok +chdir ".." @@ -373,8 +371,8 @@ Reading directory entries under `cwd` and outside of `cwd`. +mkdir -> ok +mkdir -> ok +read_dir -> ["test-1"; "test-2"] -+read_dir -> Eio.Fs.Permission_denied ("..", _) -+read_dir -> Eio.Fs.Not_found ("test-3", _) ++Eio.Io Fs Permission_denied _, reading directory ++Eio.Io Fs Not_found _, reading directory - : unit = () ``` @@ -391,7 +389,8 @@ Can use `fs` to access absolute paths: Path.with_open_in (cwd / Filename.null) (fun flow -> Eio.Flow.copy flow (Eio.Flow.buffer_sink b));;; +Read "/dev/null" and got "" +Trying with cwd instead fails: -Exception: Eio.Fs.Permission_denied ("/dev/null", _) +Exception: Eio.Io Fs Permission_denied _, + opening ``` ## Streamling lines @@ -481,7 +480,7 @@ Confined: +read -> "FOO" +rename to -> ok +read -> "FOO" -+rename to -> Eio.Fs.Permission_denied ("../foo", _) ++Eio.Io Fs Permission_denied _, renaming to - : unit = () ``` @@ -491,7 +490,7 @@ Unconfined: # run @@ fun env -> try_rename env#fs;; +mkdir -> ok +rename to -> ok -+write -> Eio.Fs.Already_exists ("foo", _) ++Eio.Io Fs Already_exists _, opening +rename to -> ok +read -> "FOO" +rename to -> ok diff --git a/tests/network.md b/tests/network.md index b2860026e..a2f0c2c0e 100644 --- a/tests/network.md +++ b/tests/network.md @@ -22,6 +22,8 @@ let read_all flow = Buffer.contents b exception Graceful_shutdown + +let () = Eio.Exn.Backend.show := false ``` ## Test cases @@ -493,7 +495,9 @@ ECONNRESET: try Eio.Flow.read_exact a (Cstruct.create 1); assert false - with Eio.Net.Connection_reset _ | End_of_file -> traceln "Connection failed (good)";; + with + | Eio.Io (Eio.Net.E Connection_reset _, _) + | End_of_file -> traceln "Connection failed (good)";; +Connection failed (good) - : unit = () ``` @@ -508,7 +512,7 @@ EPIPE: try Eio.Flow.copy_string "foo" a; assert false - with Eio.Net.Connection_reset _ -> traceln "Connection failed (good)";; + with Eio.Io (Eio.Net.E Connection_reset _, _) -> traceln "Connection failed (good)";; +Connection failed (good) - : unit = () ``` @@ -518,13 +522,9 @@ Connection refused: ```ocaml # Eio_main.run @@ fun env -> Switch.run @@ fun sw -> - try - ignore (Eio.Net.connect ~sw env#net (`Unix "idontexist.sock")); - assert false - with Eio.Net.Connection_failure _ -> - traceln "Connection failure";; -+Connection failure -- : unit = () + Eio.Net.connect ~sw env#net (`Unix "idontexist.sock");; +Exception: Eio.Io Fs Not_found _, + connecting to unix:idontexist.sock ``` ## Shutdown @@ -610,7 +610,7 @@ Connection refused: let net = Eio_mock.Net.make "mock-net" let addr1 = `Tcp (Eio.Net.Ipaddr.V4.loopback, 80) let addr2 = `Tcp (Eio.Net.Ipaddr.of_raw "\001\002\003\004", 8080) -let connection_failure = Eio.Net.Connection_failure (Failure "Simulated connection failure") +let connection_failure = Eio.Net.err (Connection_failure (Refused Eio_mock.Simulated_failure)) ``` No usable addresses: @@ -621,8 +621,8 @@ No usable addresses: Eio.Net.with_tcp_connect ~host:"www.example.com" ~service:"http" net (fun _ -> assert false);; +mock-net: getaddrinfo ~service:http www.example.com Exception: -Eio__Net.Connection_failure - (Failure "No TCP addresses for \"www.example.com\""). +Eio.Io Net Connection_failure No_matching_addresses, + connecting to "www.example.com":http ``` First address works: @@ -678,7 +678,9 @@ Both addresses fail: +mock-net: connect to tcp:127.0.0.1:80 +mock-net: connect to tcp:1.2.3.4:8080 Exception: -Eio__Net.Connection_failure (Failure "Simulated connection failure"). +Eio.Io Net Connection_failure Refused _, + connecting to tcp:1.2.3.4:8080, + connecting to "www.example.com":http ``` First attempt times out: @@ -736,7 +738,9 @@ Both attempts time out: +mock time is now 10 +mock-net: connect to tcp:1.2.3.4:8080 +mock time is now 20 -Exception: Eio__Net.Connection_failure Eio__Time.Timeout. +Exception: +Eio.Io Net Connection_failure Timeout, + connecting to "www.example.com":http ``` ## read/write on SOCK_DGRAM diff --git a/tests/switch.md b/tests/switch.md index 3aee6266d..df1fed936 100644 --- a/tests/switch.md +++ b/tests/switch.md @@ -105,9 +105,8 @@ Exception: Failure "Failed". (fun () -> Eio.Cancel.protect Fiber.yield; failwith "Failed 2") );; Exception: Multiple exceptions: -Failure("Failed 1") -and -Failure("Failed 2") +- Failure("Failed 1") +- Failure("Failed 2") ``` The switch is already turned off when we try to fork. The new fiber doesn't start: @@ -328,9 +327,8 @@ A release operation itself fails: +release 2 +release 1 Exception: Multiple exceptions: -Failure("failure 3") -and -Failure("failure 1") +- Failure("failure 3") +- Failure("failure 1") ``` Attaching a release handler to a finished switch from a cancelled context: @@ -343,9 +341,8 @@ Attaching a release handler to a finished switch from a cancelled context: +release 1 Exception: Multiple exceptions: -Failure("Parent cancelled too!") -and -Invalid_argument("Switch finished!") +- Failure("Parent cancelled too!") +- Invalid_argument("Switch finished!") ``` Using switch from inside release handler: @@ -390,11 +387,9 @@ All release hooks run, even if some fail, and all errors are reported: );; Exception: Multiple exceptions: -Stdlib.Exit -and -Failure("cancel1 failed") -and -Failure("cancel2 failed") +- Stdlib.Exit +- Failure("cancel1 failed") +- Failure("cancel2 failed") ``` # Errors during cleanup are reported during cancellation @@ -408,7 +403,6 @@ Failure("cancel2 failed") );; Exception: Multiple exceptions: -Failure("simulated error") -and -Failure("cleanup failed") +- Failure("simulated error") +- Failure("cleanup failed") ```