diff --git a/lib_eio/path.ml b/lib_eio/path.ml
index 6f5875d0c..2ad1d3a88 100644
--- a/lib_eio/path.ml
+++ b/lib_eio/path.ml
@@ -11,6 +11,34 @@ let pp f ((t:#Fs.dir), p) =
if p = "" then Fmt.pf f "<%t>" t#pp
else Fmt.pf f "<%t:%s>" t#pp (String.escaped p)
+let split_last_seg p =
+ (* Get the last instance of a character in a string *)
+ let rec rindex i c path =
+ if i < 0 then None else
+ if Char.equal (String.unsafe_get path i) c
+ then Some i
+ else rindex (i - 1) c path
+ in
+ (* Trim the last instances of a character in a string *)
+ let rtrim c path =
+ let len = String.length path in
+ let rec remove i =
+ if i > len then i else
+ if Char.equal (String.unsafe_get path (len - 1 - i)) c then remove (i + 1)
+ else i
+ in
+ let remove_last = remove 0 in
+ String.sub path 0 (len - remove_last)
+ in
+ let len = String.length p - 1 in
+ match rindex len '/' p with
+ | None -> None, Some p
+ | Some idx ->
+ (* We want the separator in the head not the tail *)
+ let idx = idx + 1 in
+ let child = String.sub p idx (len - idx + 1) in
+ Some (rtrim '/' @@ String.sub p 0 idx), (if String.equal child "" then None else Some child)
+
let open_in ~sw ((t:#Fs.dir), path) =
try t#open_in ~sw path
with Exn.Io _ as ex ->
@@ -94,3 +122,42 @@ let rename ((t1:#Fs.dir), old_path) (t2, 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)
+
+(* TODO: An exists function that doesn't need to open the file
+ but that is still capability-like ? *)
+let exists path =
+ try
+ with_open_in path @@ fun _ -> true
+ with
+ | Exn.Io ((Fs.E Fs.Not_found _), _) -> false
+
+let mkdirs ?(exists_ok=false) ~perm ((t:#Fs.dir), path) =
+ let rec loop name =
+ let parent, child =
+ match split_last_seg name with
+ | (Some _ as p), (Some _ as c) -> p, c
+ | Some parent, None -> split_last_seg parent
+ | None, _ -> None, None
+ in
+ let () =
+ match parent, child with
+ | Some parent, Some _ -> (
+ try
+ if not (exists (t, parent)) then loop parent
+ with
+ | Exn.Io ((Fs.E Fs.Permission_denied _), _) as exn ->
+ let bt = Printexc.get_raw_backtrace () in
+ Exn.reraise_with_context exn bt "whilst creating directory %a" pp (t, path)
+ )
+ | _ -> ()
+ in
+ try t#mkdir ~perm name with
+ | Exn.Io ((Fs.E Fs.Already_exists _), _) as exn ->
+ if not exists_ok then
+ let bt = Printexc.get_raw_backtrace () in
+ Exn.reraise_with_context exn bt "creating directory %a" pp (t, path)
+ | exn ->
+ let bt = Printexc.get_raw_backtrace () in
+ Exn.reraise_with_context exn bt "creating directory %a" pp (t, path)
+ in
+ loop path
diff --git a/lib_eio/path.mli b/lib_eio/path.mli
index 77ac9fd83..823303a2d 100644
--- a/lib_eio/path.mli
+++ b/lib_eio/path.mli
@@ -89,7 +89,11 @@ val with_open_out :
(** {1 Directories} *)
val mkdir : perm:File.Unix_perm.t -> _ t -> unit
-(** [mkdir ~perm t] creates a new directory [t] with permissions [perm]. *)
+(** [mkdir ?exist_ok ~perm t] creates a new directory [t] with permissions [perm]. *)
+
+val mkdirs : ?exists_ok:bool -> perm:File.Unix_perm.t -> _ t -> unit
+(** Recursively create directories. If [exist_ok] is [false] (the default) then we raise
+ {! Fs.Already_exists}. *)
val open_dir : sw:Switch.t -> _ t ->
t
(** [open_dir ~sw t] opens [t].
diff --git a/lib_eio_windows/test/test_fs.ml b/lib_eio_windows/test/test_fs.ml
index 553a55b7f..75435927b 100755
--- a/lib_eio_windows/test/test_fs.ml
+++ b/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 "@[%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,7 +89,7 @@ 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)
@@ -92,7 +97,7 @@ let test_if_missing env () =
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,8 +130,21 @@ 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.
@@ -134,11 +152,11 @@ let test_symlink env () =
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 _), _) -> ()
diff --git a/tests/fs.md b/tests/fs.md
index cc91d46e4..adb222cf9 100644
--- a/tests/fs.md
+++ b/tests/fs.md
@@ -36,6 +36,11 @@ let try_mkdir path =
| () -> traceln "mkdir %a -> ok" Path.pp path
| exception ex -> traceln "@[%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 "@[%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
@@ -212,6 +217,48 @@ Creating directories with nesting, symlinks, etc:
- : unit = ()
```
+# 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_kind nested `Directory;
+ let one_more = Path.(nested / "subdir4") in
+ try_mkdirs one_more;
+ try_mkdirs ~exists_ok:true one_more;
+ try_mkdirs one_more;
+ assert_kind one_more `Directory;
+ try_mkdirs (cwd / ".." / "outside");
++mkdirs -> ok
++mkdirs -> ok
++mkdirs -> ok
++Eio.Io Fs Already_exists _, creating directory
++Eio.Io Fs Permission_denied _, opening , whilst creating directory
+- : 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_kind (cwd / lots_of_slashes) `Directory;
+ try_mkdirs (cwd / "..");;
++Eio.Io Fs Already_exists _, creating directory
++Eio.Io Fs Already_exists _, creating directory
++mkdirs -> ok
++Eio.Io Fs Permission_denied _, creating directory
+- : unit = ()
+```
+
# Unlink
You can remove a file using unlink: