From f754042b2de05a83d618399bde2740887594549e Mon Sep 17 00:00:00 2001 From: Patrick Ferris Date: Wed, 27 Sep 2023 12:18:28 +0100 Subject: [PATCH] Add Path.mkdirs and Path.split Co-authored-by: Thomas Leonard --- lib_eio/path.ml | 45 ++++++++++++++++ lib_eio/path.mli | 26 ++++++++++ lib_eio_posix/fs.ml | 19 +++---- lib_eio_windows/test/test_fs.ml | 46 ++++++++++++----- tests/fs.md | 91 +++++++++++++++++++++++++++++++++ 5 files changed, 202 insertions(+), 25 deletions(-) diff --git a/lib_eio/path.ml b/lib_eio/path.ml index 48d8d96f2..22fc5d579 100644 --- a/lib_eio/path.ml +++ b/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 -> () diff --git a/lib_eio/path.mli b/lib_eio/path.mli index 768e73e34..f21f582bf 100644 --- a/lib_eio/path.mli +++ b/lib_eio/path.mli @@ -61,6 +61,25 @@ 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 (dir, "") = None] + + 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, "bar") = Some ((root, ""), "bar")] + - [split (root, ".") = Some ((root, ""), ".")] + - [split (root, "") = None] + - [split (root, "/") = None] +*) + (** {1 Reading files} *) val load : _ t -> string @@ -112,6 +131,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]. diff --git a/lib_eio_posix/fs.ml b/lib_eio_posix/fs.ml index 9e5499216..d543d2e0d 100644 --- a/lib_eio_posix/fs.ml +++ b/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 } 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 6b46e985a..67fdb03f8 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 @@ -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 -> ok ++mkdirs -> ok ++mkdirs -> ok ++Eio.Io Fs Already_exists _, creating directory ++Eio.Io Fs Permission_denied _, examining , 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 (Eio.Path.is_directory (cwd / lots_of_slashes)); + 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: @@ -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: + -> symbolic link / Fs Not_found _ + -> directory + -> Fs Permission_denied _ ++ -> directory + -> symbolic link / Fs Permission_denied _ + -> Fs Not_found _ - : unit = ()