Merge pull request #2052 from rgrinberg/opendir-path

Use Unix.opendir to list directories

bin/install_uninstall.ml

@@ -104,10 +104,13 @@ module File_ops_real : FILE_OPERATIONS = struct
   let remove_dir_if_empty dir =
     if Path.exists dir then
       match Path.readdir_unsorted dir with
-      | [] ->
-          Printf.eprintf "Deleting empty directory %s\n%!"
+      | Ok [] ->
+        Printf.eprintf "Deleting empty directory %s\n%!"
           (Path.to_string_maybe_quoted dir);
         print_unix_error (fun () -> Path.rmdir dir)
+      | Error e ->
+        Format.eprintf "@{<error>Error@}: %s@."
+          (Unix.error_message e)
       | _  -> ()
 
   let mkdir_p = Path.mkdir_p

src/build_system.ml

@@ -623,8 +623,14 @@ let get_dir_status t ~dir =
     else if not (Path.is_managed dir) then
       Dir_status.Loaded
         (match Path.readdir_unsorted dir with
-         | exception _ -> Path.Set.empty
-         | files ->
+         | Error Unix.ENOENT -> Path.Set.empty
+         | Error m ->
+           Errors.warn Loc.none
+             "Unable to read %s@.Reason: %s@."
+             (Path.to_string_maybe_quoted dir)
+             (Unix.error_message m);
+           Path.Set.empty
+         | Ok files ->
            Path.Set.of_list (List.map files ~f:(Path.relative dir)))
     else begin
       let (ctx, sub_dir) = Path.extract_build_context_exn dir in
@@ -832,7 +838,8 @@ let remove_old_artifacts t ~dir ~subdirs_to_keep =
   else
     match Path.readdir_unsorted dir with
     | exception _ -> ()
-    | files ->
+    | Error _ -> ()
+    | Ok files ->
       List.iter files ~f:(fun fn ->
         let path = Path.relative dir fn in
         let path_is_a_target = Path.Table.mem t.files path in

src/file_tree.ml

@@ -170,7 +170,7 @@ type readdir =
 
 let readdir path =
   match Path.readdir_unsorted path with
-  | exception (Sys_error msg) ->
+  | Error unix_error ->
     Errors.warn Loc.none
       "Unable to read directory %s. Ignoring.@.\
        Remove this message by ignoring by adding:@.\
@@ -180,9 +180,9 @@ let readdir path =
       (Path.to_string_maybe_quoted path)
       (Path.basename path)
       (Path.to_string_maybe_quoted (Path.relative (Path.parent_exn path) "dune"))
-      msg;
-    Error msg
-  | unsorted_contents ->
+      (Unix.error_message unix_error);
+    Error unix_error
+  | Ok unsorted_contents ->
     let files, dirs =
       List.filter_partition_map unsorted_contents ~f:(fun fn ->
         let path = Path.relative path fn in
@@ -307,7 +307,7 @@ let load ?(warn_when_seeing_jbuild_file=true) path =
   | Ok dir -> dir
   | Error m ->
     die "Unable to load source %s.@.Reason:%s@."
-      (Path.to_string_maybe_quoted path) m
+      (Path.to_string_maybe_quoted path) (Unix.error_message m)
 
 let fold = Dir.fold
 

src/findlib.ml

@@ -438,12 +438,18 @@ let available t name = Result.is_ok (find t name)
 let root_packages t =
   let pkgs =
     List.concat_map t.paths ~f:(fun dir ->
-      Path.readdir_unsorted dir
-      |> List.filter_map ~f:(fun name ->
-        if Path.exists (Path.relative dir (name ^ "/META")) then
-          Some (Lib_name.of_string_exn ~loc:None name)
-        else
-          None))
+      match Path.readdir_unsorted dir with
+      | Error unix_error ->
+        die
+          "Unable to read directory %s for findlib package@.Reason:%s@."
+          (Path.to_string_maybe_quoted dir)
+          (Unix.error_message unix_error)
+      | Ok listing ->
+        List.filter_map listing ~f:(fun name ->
+          if Path.exists (Path.relative dir (name ^ "/META")) then
+            Some (Lib_name.of_string_exn ~loc:None name)
+          else
+            None))
     |> Lib_name.Set.of_list
   in
   let builtins = Lib_name.Set.of_list (Lib_name.Map.keys t.builtins) in

src/promotion.ml

@@ -70,7 +70,8 @@ let do_promote db files_to_promote =
   let potential_build_contexts =
     match Path.readdir_unsorted Path.build_dir with
     | exception _ -> []
-    | files ->
+    | Error _ -> []
+    | Ok files ->
       List.filter_map files ~f:(fun fn ->
         if fn = "" || fn.[0] = '.' || fn = "install" then
           None

src/stdune/path.ml

@@ -859,7 +859,26 @@ let explode_exn t =
 let exists t =
   try Sys.file_exists (to_string t)
   with Sys_error _ -> false
-let readdir_unsorted t = Sys.readdir (to_string t) |> Array.to_list
+let readdir_unsorted =
+  let rec loop dh acc =
+    match Unix.readdir dh with
+    | "."
+    | ".." -> loop dh acc
+    | s -> loop dh (s :: acc)
+    | exception End_of_file -> acc
+  in
+  fun t ->
+    try
+      let dh = Unix.opendir (to_string t) in
+      Exn.protect
+        ~f:(fun () ->
+          match loop dh [] with
+          | exception (Unix.Unix_error (e, _, _)) -> Error e 
+          | s -> Ok s)
+        ~finally:(fun () -> Unix.closedir dh)
+    with
+      Unix.Unix_error (e, _, _) -> Error e
+
 let is_directory t =
   try Sys.is_directory (to_string t)
   with Sys_error _ -> false

src/stdune/path.mli

@@ -134,7 +134,7 @@ val split_first_component : t -> (string * t) option
 val insert_after_build_dir_exn : t -> string -> t
 
 val exists : t -> bool
-val readdir_unsorted : t -> string list
+val readdir_unsorted : t -> (string list, Unix.error) Result.t
 val is_directory : t -> bool
 val is_file : t -> bool
 val rmdir : t -> unit

test/blackbox-tests/test-cases/unreadable-src/run.t

@@ -5,6 +5,6 @@
   Remove this message by ignoring by adding:
   (dirs \ foo)
   to the dune file: dune
-  Reason: foo: Permission denied
+  Reason: Permission denied
 
   $ chmod +r foo && rm -rf foo