Merge pull request #692 from talex5/stat-bench

Stat benchmark: report cleanup time and optimise

bench/bench_stat.ml

@@ -38,25 +38,19 @@ module Bench_dir = struct
     | File { name; size; perm } ->
       Fmt.pf ppf "file %s (0o%o) %Lu" name perm size
 
-  let make random fs t =
-    let limit = Eio.Semaphore.make 32 in        (* Prevent FD exhaustion *)
-    let rec aux fs = function
+  let make fs t =
+    let rec aux iter fs = function
       | Dir { name; perm; children } ->
         let dir = fs / name in
-        Eio.Semaphore.acquire limit;
         Path.mkdir ~perm dir;
-        Eio.Semaphore.release limit;
-        Fiber.List.iter (aux dir) children
+        iter (aux List.iter dir) children
       | File { name; size; perm } ->
-        Eio.Semaphore.acquire limit;
         let buf = Cstruct.create (Int64.to_int size) in
-        Eio.Flow.read_exact random buf;
         Path.with_open_out ~create:(`If_missing perm) (fs / name) (fun oc ->
             Eio.Flow.write oc [ buf ]
-          );
-        Eio.Semaphore.release limit
+          )
     in
-    aux fs t
+    aux Fiber.List.iter fs t
 end
 
 let with_tmp_dir ~fs prefix suffix fn =
@@ -66,30 +60,27 @@ let with_tmp_dir ~fs prefix suffix fn =
   fn dir
 
 let bench_stat root =
-  let limit = Eio.Semaphore.make 32 in        (* Prevent FD exhaustion *)
-  let rec aux dir =
-    Eio.Semaphore.acquire limit;
+  let rec aux level dir =
     let { Eio.File.Stat.kind; perm; size; _ } = Path.stat ~follow:false dir in
     match kind with
     | `Directory ->
       let items = Path.read_dir dir in
-      Eio.Semaphore.release limit;
-      let children = items |> Fiber.List.map (fun f -> aux (dir / f)) in
+      let map = if level > 3 then List.map else Fiber.List.map ?max_fibers:None in
+      let children = items |> map (fun f -> aux (level + 1) (dir / f)) in
       let name = Path.native_exn dir |> Filename.basename in
       Bench_dir.Dir { name; perm; children }
     | `Regular_file ->
-      Eio.Semaphore.release limit;
       let name = Path.native_exn dir |> Filename.basename in
       File { name; perm; size = Optint.Int63.to_int64 size }
     | _ -> assert false
   in
-  aux root
+  aux 1 root
 
 let file name = Bench_dir.File { name; perm = 0o644; size = 128L }
 let dir name children = Bench_dir.Dir { name; perm = 0o700; children }
 
 let random_bench_dir ~n ~levels =
-  if levels < 0 then invalid_arg "Levels should be > 0";
+  if levels < 1 then invalid_arg "Levels should be >= 1";
   let rec loop root = function
     | 1 -> (
         match root with
@@ -109,16 +100,16 @@ let random_bench_dir ~n ~levels =
   in
   loop (dir "root" []) levels
 
-let run_bench ~n ~levels ~random ~root ~clock =
+let run_bench ~n ~levels ~root ~clock =
   let dir = random_bench_dir ~levels ~n |> Bench_dir.sort in
   traceln "Going to create %i files and directories" (Bench_dir.size dir);
   let create_time =
     let t0 = Eio.Time.now clock in
-    Bench_dir.make random root dir;
+    Bench_dir.make root dir;
     let t1 = Eio.Time.now clock in
     t1 -. t0
   in
-  traceln "Created %i files and directories in %.2f s" (Bench_dir.size dir) create_time;
+  traceln "Created in %.2f s" create_time;
   let bench () =
     Gc.full_major ();
     let stat0 = Gc.stat () in
@@ -136,16 +127,26 @@ let run_bench ~n ~levels ~random ~root ~clock =
     | _ -> failwith "Stat not the same as the spec"
   in
   let time, minor, major = bench () in
+  traceln "Statted in %.2f s" time;
+  let remove_time =
+    let t0 = Eio.Time.now clock in
+    let root = root / "root" in
+    Eio.Path.read_dir root |> Fiber.List.iter (fun item -> Eio.Path.rmtree (root / item));
+    Eio.Path.rmdir root;
+    let t1 = Eio.Time.now clock in
+    t1 -. t0
+  in
+  traceln "Removed in %.2f s" remove_time;
   [ 
     Metric.create "create-time" (`Float (1e3 *. create_time)) "ms" (Fmt.str "Time to create %i files and directories" (Bench_dir.size dir));
     Metric.create "stat-time" (`Float (1e3 *. time)) "ms" (Fmt.str "Time to stat %i files and directories" (Bench_dir.size dir));
     Metric.create "stat-minor" (`Float (1e-3 *. minor)) "kwords" (Fmt.str "Minor words allocated to stat %i files and directories" (Bench_dir.size dir));
-    Metric.create "stat-major" (`Float (1e-3 *. major)) "kwords" (Fmt.str "Major words allocated  %i files and directories" (Bench_dir.size dir))
+    Metric.create "stat-major" (`Float (1e-3 *. major)) "kwords" (Fmt.str "Major words allocated  %i files and directories" (Bench_dir.size dir));
+    Metric.create "remove-time" (`Float (1e3 *. remove_time)) "ms" "Time to remove everything";
   ]
 
 let run env =
   let fs = Eio.Stdenv.fs env in
-  let random = Eio.Stdenv.secure_random env in
   let clock = Eio.Stdenv.clock env in
   with_tmp_dir ~fs "eio-bench-" "-stat" @@ fun root ->
-  run_bench ~n:20 ~levels:4 ~root ~random ~clock
+  run_bench ~n:20 ~levels:4 ~root ~clock

bench/main.ml

@@ -1,3 +1,5 @@
+open Eio.Std
+
 let benchmarks = [
   "Promise", Bench_promise.run;
   "Cancel", Bench_cancel.run;
@@ -22,6 +24,7 @@ let usage_error () =
 
 let () =
   Eio_main.run @@ fun env ->
+  traceln "Using %s backend" env#backend_id;
   let benchmarks =
     match Array.to_list Sys.argv with
     | [_] -> benchmarks
@@ -35,7 +38,7 @@ let () =
     | _ -> usage_error ()
   in
   let run (name, fn) =
-    Eio.traceln "Running %s..." name;
+    traceln "Running %s..." name;
     let metrics = fn env in
     `Assoc [
       "name", `String name;

lib_eio/unix/fd.ml

@@ -77,6 +77,8 @@ let is_seekable t =
     t.seekable <- if seekable then Yes else No;
     seekable
 
+let is_open t = Rcfd.is_open t.fd
+
 let rec use_exn_list op xs k =
   match xs with
   | [] -> k []

lib_eio/unix/fd.mli

@@ -55,6 +55,12 @@ val remove : t -> Unix.file_descr option
 
     Returns [None] if [t] is closed by another fiber first. *)
 
+val is_open : t -> bool
+(** [is_open t] returns [true] until [t] has been marked as closing, after which it returns [false].
+
+    This is mostly useful inside the callback of {!use}, to test whether
+    another fiber has started closing [t] (in which case you may decide to stop early). *)
+
 (** {2 Flags} *)
 
 val is_blocking : t -> bool

lib_eio_linux/sched.ml

@@ -535,7 +535,8 @@ let with_eventfd fn =
 let with_sched ?(fallback=no_fallback) config fn =
   let { queue_depth; n_blocks; block_size; polling_timeout } = config in
   match Uring.create ~queue_depth ?polling_timeout () with
-  | exception Unix.Unix_error(Unix.ENOSYS, _, _) -> fallback (`Msg "io_uring is not available on this system")
+  | exception Unix.Unix_error(ENOSYS, _, _) -> fallback (`Msg "io_uring is not available on this system")
+  | exception Unix.Unix_error(EPERM, _, _) -> fallback (`Msg "io_uring is not available (permission denied)")
   | uring ->
     let probe = Uring.get_probe uring in
     if not (Uring.op_supported probe Uring.Op.shutdown) then (

lib_eio_posix/include/discover.ml

@@ -8,7 +8,7 @@ let optional_flags = [
 
 let () =
   C.main ~name:"discover" (fun c ->
-      let c_flags = ["-D_LARGEFILE64_SOURCE"; "-D_XOPEN_SOURCE=700"; "-D_DARWIN_C_SOURCE"] in
+      let c_flags = ["-D_LARGEFILE64_SOURCE"; "-D_XOPEN_SOURCE=700"; "-D_DARWIN_C_SOURCE"; "-D_GNU_SOURCE"] in
       let includes = ["sys/types.h"; "sys/stat.h"; "fcntl.h"] in
       let extra_flags, missing_defs =
         C.C_define.import c ~c_flags ~includes

tests/fs.md

@@ -519,6 +519,45 @@ Create a sandbox, write a file with it, then read it from outside:
 - : unit = ()
 ```
 
+```ocaml
+# run ~clear:["foo"] @@ fun env ->
+  let fs = env#fs in
+  let cwd = env#cwd in
+  Path.mkdirs (cwd / "foo/bar") ~perm:0o700;
+  let test ?(succeeds=true) path =
+    Eio.Exn.Backend.show := succeeds;
+    try
+      Switch.run @@ fun sw ->
+      let _ : _ Path.t = Path.open_dir ~sw path in
+      traceln "open_dir %a -> OK" Path.pp path
+    with ex ->
+      traceln "@[<h>%a@]" Eio.Exn.pp ex
+  in
+  let reject = test ~succeeds:false in
+  test (cwd / "foo/bar");
+  reject (cwd / "..");
+  test (cwd / ".");
+  reject (cwd / "/");
+  test (cwd / "foo/bar/..");
+  test (fs / "foo/bar");
+  Unix.symlink ".." "foo/up";
+  test (cwd / "foo/up/foo/bar");
+  Unix.symlink "/" "foo/root";
+  reject (cwd / "foo/root/..");
++open_dir <cwd:foo/bar> -> OK
++Eio.Io Fs Permission_denied _, opening directory <cwd:..>
++open_dir <cwd:.> -> OK
++Eio.Io Fs Permission_denied _, opening directory <cwd:/>
++open_dir <cwd:foo/bar/..> -> OK
++open_dir <fs:foo/bar> -> OK
++open_dir <cwd:foo/up/foo/bar> -> OK
++Eio.Io Fs Permission_denied _, opening directory <cwd:foo/root/..>
+- : unit = ()
+
+# Eio.Exn.Backend.show := false
+- : unit = ()
+```
+
 # Unconfined FS access
 
 We create a directory and chdir into it.
@@ -684,7 +723,7 @@ let try_rename t =
 Confined:
 
 ```ocaml
-# run ~clear:["tmp"; "dir"] @@ fun env -> try_rename env#cwd;;
+# run ~clear:["tmp"; "dir"; "foo"] @@ fun env -> try_rename env#cwd;;
 +mkdir <cwd:tmp> -> ok
 +rename <cwd:tmp> to <cwd:dir> -> ok
 +write <cwd:foo> -> ok