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: