Merge pull request #625 from talex5/mkdirs

Add Path.mkdirs and Path.split

Author: talex5

lib_eio/path.ml

@@ -21,6 +21,38 @@ let native_exn t =
   | Some p -> p
   | None -> raise (Fs.err (Not_native (Fmt.str "%a" pp t)))
 
+(* Drop the first [n] characters from [s]. *)
+let string_drop s n =
+  String.sub s n (String.length s - n)
+
+(* "/foo/bar//" -> "/foo/bar"
+   "///" -> "/"
+   "foo/bar" -> "foo/bar"
+ *)
+let remove_trailing_slashes s =
+  let rec aux i =
+    if i <= 1 || s.[i - 1] <> '/' then (
+      if i = String.length s then s
+      else String.sub s 0 i
+    ) else aux (i - 1)
+  in
+  aux (String.length s)
+
+let split (dir, p) =
+  match remove_trailing_slashes p with
+  | "" -> None
+  | "/" -> None
+  | p ->
+    match String.rindex_opt p '/' with
+    | None -> Some ((dir, ""), p)
+    | Some idx ->
+      let basename = string_drop p (idx + 1) in
+      let dirname =
+        if idx = 0 then "/"
+        else remove_trailing_slashes (String.sub p 0 idx)
+      in
+      Some ((dir, dirname), basename)
+
 let open_in ~sw t =
   let (Resource.T (dir, ops), path) = t in
   let module X = (val (Resource.get ops Fs.Pi.Dir)) in
@@ -139,3 +171,16 @@ let rename t1 t2 =
   with Exn.Io _ as ex ->
     let bt = Printexc.get_raw_backtrace () in
     Exn.reraise_with_context ex bt "renaming %a to %a" pp t1 pp t2
+
+let rec mkdirs ?(exists_ok=false) ~perm t =
+  (* Check parent exists first. *)
+  split t |> Option.iter (fun (parent, _) ->
+      match is_directory parent with
+      | true -> ()
+      | false -> mkdirs ~perm ~exists_ok:true parent
+      | exception (Exn.Io _ as ex) ->
+        let bt = Printexc.get_raw_backtrace () in
+        Exn.reraise_with_context ex bt "creating directory %a" pp t
+    );
+  try mkdir ~perm t
+  with Exn.Io (Fs.E Already_exists _, _) when exists_ok && is_directory t -> ()

lib_eio/path.mli

@@ -61,6 +61,26 @@ val native : _ t -> string option
 val native_exn : _ t -> string
 (** Like {!native}, but raise a suitable exception if the path is not a native path. *)
 
+val split : 'a t -> ('a t * string) option
+(** [split t] returns [Some (dir, basename)], where [basename] is the last path component in [t]
+    and [dir] is [t] without [basename].
+
+    [dir / basename] refers to the same path as [t].
+
+    [split t = None] if there is nothing to split.
+
+    For example:
+
+    - [split (root, "foo/bar") = Some ((root, "foo"), "bar")]
+    - [split (root, "/foo/bar") = Some ((root, "/foo"), "bar")]
+    - [split (root, "/foo/bar/baz") = Some ((root, "/foo/bar"), "baz")]
+    - [split (root, "/foo/bar//baz/") = Some ((root, "/foo/bar"), "baz")]
+    - [split (root, "bar") = Some ((root, ""), "bar")]
+    - [split (root, ".") = Some ((root, ""), ".")]
+    - [split (root, "") = None]
+    - [split (root, "/") = None]
+*)
+
 (** {1 Reading files} *)
 
 val load : _ t -> string
@@ -112,6 +132,13 @@ val with_open_out :
 val mkdir : perm:File.Unix_perm.t -> _ t -> unit
 (** [mkdir ~perm t] creates a new directory [t] with permissions [perm]. *)
 
+val mkdirs : ?exists_ok:bool -> perm:File.Unix_perm.t -> _ t -> unit
+(** [mkdirs ~perm t] creates directory [t] along with any missing ancestor directories, recursively.
+
+    All created directories get permissions [perm], but existing directories do not have their permissions changed.
+
+    @param exist_ok If [false] (the default) then we raise {! Fs.Already_exists} if [t] is already a directory. *)
+
 val open_dir : sw:Switch.t -> _ t -> [`Close | dir_ty] t
 (** [open_dir ~sw t] opens [t].
 

lib_eio_posix/fs.ml

@@ -72,17 +72,14 @@ end = struct
     if t.sandbox then (
       if t.closed then Fmt.invalid_arg "Attempt to use closed directory %S" t.dir_path;
       let dir, leaf = Filename.dirname path, Filename.basename path in
-      if leaf = ".." then (
-        (* We could be smarter here and normalise the path first, but '..'
-           doesn't make sense for any of the current uses of [with_parent_dir]
-           anyway. *)
-        raise (Eio.Fs.err (Permission_denied (Err.Invalid_leaf leaf)))
-      ) else (
-        let dir = resolve t dir in
-        Switch.run @@ fun sw ->
-        let dirfd = Low_level.openat ~sw ~mode:0 dir Low_level.Open_flags.(directory + rdonly + nofollow) in
-        fn (Some dirfd) leaf
-      )
+      let dir, leaf =
+        if leaf = ".." then path, "."
+        else dir, leaf
+      in
+      let dir = resolve t dir in
+      Switch.run @@ fun sw ->
+      let dirfd = Low_level.openat ~sw ~mode:0 dir Low_level.Open_flags.(directory + rdonly + nofollow) in
+      fn (Some dirfd) leaf
     ) else fn None path
 
   let v ~label ~sandbox dir_path = { dir_path; sandbox; label; closed = false }

lib_eio_windows/test/test_fs.ml

@@ -23,6 +23,11 @@ let try_mkdir path =
   | () -> traceln "mkdir %a -> ok" Path.pp path
   | exception ex -> raise ex
 
+let try_mkdirs ?exists_ok path =
+  match Path.mkdirs ?exists_ok path ~perm:0o700 with
+  | () -> traceln "mkdirs %a -> ok" Path.pp path
+  | exception ex -> traceln "@[<h>%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
@@ -75,7 +80,7 @@ let test_exclusive env () =
   Eio.traceln "fiest";
   Path.save ~create:(`Exclusive 0o666) path "first-write";
   Eio.traceln "next";
-  try 
+  try
     Path.save ~create:(`Exclusive 0o666) path "first-write";
     Eio.traceln "nope";
     failwith "Should have failed"
@@ -84,15 +89,15 @@ let test_exclusive env () =
 let test_if_missing env () =
   let cwd = Eio.Stdenv.cwd env in
   let test_file = (cwd / "test-file") in
-  with_temp_file test_file @@ fun test_file -> 
+  with_temp_file test_file @@ fun test_file ->
   Path.save ~create:(`If_missing 0o666) test_file "1st-write-original";
   Path.save ~create:(`If_missing 0o666) test_file "2nd-write";
   Alcotest.(check string) "same contents" "2nd-write-original" (Path.load test_file)
 
 let test_trunc env () =
   let cwd = Eio.Stdenv.cwd env in
   let test_file = (cwd / "test-file") in
-  with_temp_file test_file @@ fun test_file -> 
+  with_temp_file test_file @@ fun test_file ->
   Path.save ~create:(`Or_truncate 0o666) test_file "1st-write-original";
   Path.save ~create:(`Or_truncate 0o666) test_file "2nd-write";
   Alcotest.(check string) "same contents" "2nd-write" (Path.load test_file)
@@ -125,20 +130,33 @@ let test_mkdir env () =
   Unix.rmdir "subdir\\nested";
   Unix.rmdir "subdir"
 
+let test_mkdirs env () =
+  let cwd = Eio.Stdenv.cwd env in
+  let nested = cwd / "subdir1" / "subdir2" / "subdir3" in
+  try_mkdirs nested;
+  let one_more = Path.(nested / "subdir4") in
+  (try
+    try_mkdirs one_more
+  with Eio.Io (Eio.Fs.E (Already_exists _), _) -> ());
+  try_mkdirs ~exists_ok:true one_more;
+  try
+    try_mkdirs (cwd / ".." / "outside")
+  with Eio.Io (Eio.Fs.E (Permission_denied _), _) -> ()
+
 let test_symlink env () =
-  (* 
+  (*
     Important note: assuming that neither "another" nor
     "to-subdir" exist, the following program will behave
     differently if you don't have the ~to_dir flag.
 
     With [to_dir] set to [true] we get the desired UNIX behaviour,
     without it [Unix.realpath] will actually show the parent directory
     of "another". Presumably this is because Windows distinguishes
-    between file symlinks and directory symlinks. Fun. 
+    between file symlinks and directory symlinks. Fun.
 
   {[ Unix.symlink ~to_dir:true "another" "to-subdir";
      Unix.mkdir "another" 0o700;
-     print_endline @@ Unix.realpath "to-subdir" |} 
+     print_endline @@ Unix.realpath "to-subdir" |}
   *)
   let cwd = Eio.Stdenv.cwd env in
   try_mkdir (cwd / "sandbox");
@@ -186,13 +204,13 @@ let test_unlink env () =
   try_unlink (cwd / "file");
   try_unlink (cwd / "subdir\\file2");
   let () =
-    try 
+    try
       try_read_file (cwd / "file");
       failwith "file should not exist"
     with Eio.Io (Eio.Fs.E (Not_found _), _) -> ()
   in
   let () =
-    try 
+    try
       try_read_file (cwd / "subdir\\file2");
       failwith "file should not exist"
     with Eio.Io (Eio.Fs.E (Not_found _), _) -> ()
@@ -201,7 +219,7 @@ let test_unlink env () =
   (* Supposed to use symlinks here. *)
   try_unlink (cwd / "subdir\\file2");
   let () =
-    try 
+    try
       try_read_file (cwd / "subdir\\file2");
       failwith "file should not exist"
     with Eio.Io (Eio.Fs.E (Not_found _), _) -> ()
@@ -211,13 +229,13 @@ let test_unlink env () =
 let try_failing_unlink env () =
   let cwd = Eio.Stdenv.cwd env in
   let () =
-    try 
+    try
       try_unlink (cwd / "missing");
       failwith "Expected not found!"
     with Eio.Io (Eio.Fs.E (Not_found _), _) -> ()
   in
   let () =
-    try 
+    try
       try_unlink (cwd / "..\\foo");
       failwith "Expected permission denied!"
     with Eio.Io (Eio.Fs.E (Permission_denied _), _) -> ()
@@ -233,13 +251,13 @@ let test_remove_dir env () =
   try_rmdir (cwd / "d1");
   try_rmdir (cwd / "subdir\\d2");
   let () =
-    try 
+    try
       try_read_dir (cwd / "d1");
       failwith "Expected not found"
     with Eio.Io (Eio.Fs.E (Not_found _), _) -> ()
-  in 
+  in
   let () =
-    try 
+    try
       try_read_dir (cwd / "subdir\\d2");
       failwith "Expected not found"
     with Eio.Io (Eio.Fs.E (Not_found _), _) -> ()

tests/fs.md

@@ -36,6 +36,11 @@ let try_mkdir path =
   | () -> traceln "mkdir %a -> ok" Path.pp path
   | exception ex -> traceln "@[<h>%a@]" Eio.Exn.pp ex
 
+let try_mkdirs ?exists_ok path =
+  match Path.mkdirs ?exists_ok path ~perm:0o700 with
+  | () -> traceln "mkdirs %a -> ok" Path.pp path
+  | exception ex -> traceln "@[<h>%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
@@ -208,6 +213,90 @@ Creating directories with nesting, symlinks, etc:
 - : unit = ()
 ```
 
+# Split
+
+```ocaml
+let fake_dir : Eio.Fs.dir_ty r = Eio.Resource.T ((), Eio.Resource.handler [])
+let split path = Eio.Path.split (fake_dir, path) |> Option.map (fun ((_, dirname), basename) -> dirname, basename)
+```
+
+```ocaml
+# split "foo/bar";
+- : (string * string) option = Some ("foo", "bar")
+
+# split "/foo/bar";
+- : (string * string) option = Some ("/foo", "bar")
+
+# split "/foo/bar/baz";
+- : (string * string) option = Some ("/foo/bar", "baz")
+
+# split "/foo/bar//baz/";
+- : (string * string) option = Some ("/foo/bar", "baz")
+
+# split "bar";
+- : (string * string) option = Some ("", "bar")
+
+# split "/bar";
+- : (string * string) option = Some ("/", "bar")
+
+# split ".";
+- : (string * string) option = Some ("", ".")
+
+# split "./";
+- : (string * string) option = Some ("", ".")
+
+# split "";
+- : (string * string) option = None
+
+# split "/";
+- : (string * string) option = None
+
+# split "///";
+- : (string * string) option = None
+```
+
+# Mkdirs
+
+Recursively creating directories with `mkdirs`.
+
+```ocaml
+# run @@ fun env ->
+  let cwd = Eio.Stdenv.cwd env in
+  let nested = cwd / "subdir1" / "subdir2" / "subdir3" in
+  try_mkdirs nested;
+  assert (Eio.Path.is_directory nested);
+  let one_more = Path.(nested / "subdir4") in
+  try_mkdirs one_more;
+  try_mkdirs ~exists_ok:true one_more;
+  try_mkdirs one_more;
+  assert (Eio.Path.is_directory one_more);
+  try_mkdirs (cwd / ".." / "outside");
++mkdirs <cwd:subdir1/subdir2/subdir3> -> ok
++mkdirs <cwd:subdir1/subdir2/subdir3/subdir4> -> ok
++mkdirs <cwd:subdir1/subdir2/subdir3/subdir4> -> ok
++Eio.Io Fs Already_exists _, creating directory <cwd:subdir1/subdir2/subdir3/subdir4>
++Eio.Io Fs Permission_denied _, examining <cwd:..>, creating directory <cwd:../outside>
+- : unit = ()
+```
+
+Some edge cases for `mkdirs`.
+
+```ocaml
+# run @@ fun env ->
+  let cwd = Eio.Stdenv.cwd env in
+  try_mkdirs (cwd / ".");
+  try_mkdirs (cwd / "././");
+  let lots_of_slashes = "./test//////////////test" in
+  try_mkdirs (cwd / lots_of_slashes);
+  assert (Eio.Path.is_directory (cwd / lots_of_slashes));
+  try_mkdirs (cwd / "..");;
++Eio.Io Fs Already_exists _, creating directory <cwd:.>
++Eio.Io Fs Already_exists _, creating directory <cwd:././>
++mkdirs <cwd:./test//////////////test> -> ok
++Eio.Io Fs Permission_denied _, creating directory <cwd:..>
+- : unit = ()
+```
+
 # Unlink
 
 You can remove a file using unlink:
@@ -561,6 +650,7 @@ Fstatat:
   try_stat (cwd / "broken-symlink");
   try_stat cwd;
   try_stat (cwd / "..");
+  try_stat (cwd / "stat_subdir2/..");
   Unix.symlink ".." "parent-symlink";
   try_stat (cwd / "parent-symlink");
   try_stat (cwd / "missing1" / "missing2");
@@ -570,6 +660,7 @@ Fstatat:
 +<cwd:broken-symlink> -> symbolic link / Fs Not_found _
 +<cwd> -> directory
 +<cwd:..> -> Fs Permission_denied _
++<cwd:stat_subdir2/..> -> directory
 +<cwd:parent-symlink> -> symbolic link / Fs Permission_denied _
 +<cwd:missing1/missing2> -> Fs Not_found _
 - : unit = ()