diff --git a/lib_eio/fs.ml b/lib_eio/fs.ml index 34505c9f1..58c3fe1ed 100644 --- a/lib_eio/fs.ml +++ b/lib_eio/fs.ml @@ -65,6 +65,7 @@ module Pi = struct val mkdir : t -> perm:File.Unix_perm.t -> path -> unit val open_dir : t -> sw:Switch.t -> path -> [`Close | dir_ty] r val read_dir : t -> path -> string list + val with_dir_entries : t -> path -> ((File.Stat.kind * string) Seq.t -> 'a) -> 'a val stat : t -> follow:bool -> string -> File.Stat.t val unlink : t -> path -> unit val rmdir : t -> path -> unit diff --git a/lib_eio/path.ml b/lib_eio/path.ml index 37cd5ff09..106419c76 100644 --- a/lib_eio/path.ml +++ b/lib_eio/path.ml @@ -106,6 +106,14 @@ let read_dir t = let bt = Printexc.get_raw_backtrace () in Exn.reraise_with_context ex bt "reading directory %a" pp t +let walk t fn = + let (Resource.T (dir, ops), path) = t in + let module X = (val (Resource.get ops Fs.Pi.Dir)) in + try X.with_dir_entries dir path fn + with Exn.Io _ as ex -> + let bt = Printexc.get_raw_backtrace () in + Exn.reraise_with_context ex bt "walking directory %a" pp t + let stat ~follow t = let (Resource.T (dir, ops), path) = t in let module X = (val (Resource.get ops Fs.Pi.Dir)) in diff --git a/lib_eio/path.mli b/lib_eio/path.mli index d147f5454..d2a448e70 100644 --- a/lib_eio/path.mli +++ b/lib_eio/path.mli @@ -155,6 +155,9 @@ val read_dir : _ t -> string list Note: The special Unix entries "." and ".." are not included in the results. *) +val walk : _ t -> ((File.Stat.kind * string) Seq.t -> 'a) -> 'a +(** [walk t] traverses the directory [t] producing a sequence of results. *) + (** {1 Metadata} *) val stat : follow:bool -> _ t -> File.Stat.t diff --git a/lib_eio/unix/dune b/lib_eio/unix/dune index e8afa88d8..7de46f5d2 100644 --- a/lib_eio/unix/dune +++ b/lib_eio/unix/dune @@ -1,11 +1,11 @@ (library (name eio_unix) (public_name eio.unix) - (public_headers include/fork_action.h) + (public_headers include/fork_action.h include/eio_unix_stubs.h) (foreign_stubs (language c) (include_dirs include) - (names fork_action stubs cap)) + (names fork_action eio_unix_stubs cap)) (libraries eio eio.utils unix threads mtime.clock.os)) (rule diff --git a/lib_eio/unix/stubs.c b/lib_eio/unix/eio_unix_stubs.c similarity index 68% rename from lib_eio/unix/stubs.c rename to lib_eio/unix/eio_unix_stubs.c index 78572bf4f..bb57ed261 100644 --- a/lib_eio/unix/stubs.c +++ b/lib_eio/unix/eio_unix_stubs.c @@ -3,11 +3,15 @@ #include #include #include +#include #include #include #include #include +#include + +#define BUF_SIZE 4096 static void caml_stat_free_preserving_errno(void *ptr) { int saved = errno; @@ -38,7 +42,7 @@ CAMLprim value eio_unix_readlinkat(value v_fd, value v_path, value v_cs) { value v_ba = Field(v_cs, 0); value v_off = Field(v_cs, 1); value v_len = Field(v_cs, 2); - char *buf = (char *)Caml_ba_data_val(v_ba) + Long_val(v_off); + char *buf = (char *)Caml_ba_data_val(v_ba) + Long_val(v_off); size_t buf_size = Long_val(v_len); int fd = Int_val(v_fd); int ret; @@ -52,3 +56,17 @@ CAMLprim value eio_unix_readlinkat(value v_fd, value v_path, value v_cs) { CAMLreturn(Val_int(ret)); #endif } + +CAMLprim value eio_unix_file_type_of_dtype (int d_type) { + switch (d_type) { + case DT_REG: return caml_hash_variant("Regular_file"); + case DT_DIR: return caml_hash_variant("Directory"); + case DT_CHR: return caml_hash_variant("Character_special"); + case DT_BLK: return caml_hash_variant("Block_device"); + case DT_LNK: return caml_hash_variant("Symbolic_link"); + case DT_FIFO: return caml_hash_variant("Fifo"); + case DT_SOCK: return caml_hash_variant("Socket"); + default: + return caml_hash_variant("Unknown"); + } +} diff --git a/lib_eio/unix/include/eio_unix_stubs.h b/lib_eio/unix/include/eio_unix_stubs.h new file mode 100644 index 000000000..e36c14134 --- /dev/null +++ b/lib_eio/unix/include/eio_unix_stubs.h @@ -0,0 +1,7 @@ +#include + +/* A function to convert directory entry kinds into + * Unix.file_kind options. + */ +CAMLprim value eio_unix_file_type_of_dtype(int d_type); + diff --git a/lib_eio_linux/eio_linux.ml b/lib_eio_linux/eio_linux.ml index 79678c99e..376f873c2 100644 --- a/lib_eio_linux/eio_linux.ml +++ b/lib_eio_linux/eio_linux.ml @@ -410,6 +410,28 @@ end = struct in Low_level.read_dir fd + let with_dir_entries t path fn = + Switch.run ~name:"with_dir_entries" @@ fun sw -> + let path = if path = "" then "." else path in + let fd = + Low_level.openat ~sw t.fd path ~seekable:false ~access:`R + ~flags:Uring.Open_flags.(cloexec + directory) + ~perm:0 + in + let rec read_entries fd : (Eio.File.Stat.kind * string) Seq.t = + let entries = Low_level.read_some_dir fd in + match entries with + | [] -> fun () -> Seq.Nil + | es -> + let rec loop = function + | [] -> read_entries fd + | e :: es -> fun () -> Seq.Cons (e, loop es) + in + loop es + in + fn (read_entries fd) + + let read_link t path = Low_level.read_link t.fd path let close t = diff --git a/lib_eio_linux/eio_stubs.c b/lib_eio_linux/eio_stubs.c index 4e4054104..419dfdd21 100644 --- a/lib_eio_linux/eio_stubs.c +++ b/lib_eio_linux/eio_stubs.c @@ -29,6 +29,7 @@ #include #include "fork_action.h" +#include "eio_unix_stubs.h" #ifndef SYS_pidfd_send_signal # define SYS_pidfd_send_signal 424 @@ -136,7 +137,7 @@ CAMLprim value caml_eio_getrandom(value v_ba, value v_off, value v_len) { CAMLprim value caml_eio_getdents(value v_fd) { CAMLparam1(v_fd); - CAMLlocal2(result, cons); + CAMLlocal3(result, cons, ventry); char buf[DIRENT_BUF_SIZE]; struct dirent64 *d; int nread, pos; @@ -145,13 +146,18 @@ CAMLprim value caml_eio_getdents(value v_fd) { caml_leave_blocking_section(); if (nread == -1) uerror("getdents", Nothing); - result = Val_int(0); /* The empty list */ + result = Val_emptylist; for (pos = 0; pos < nread;) { d = (struct dirent64 *) (buf + pos); - cons = caml_alloc(2, 0); - Store_field(cons, 0, caml_copy_string_of_os(d->d_name)); // Head - Store_field(cons, 1, result); // Tail + + ventry = caml_alloc(2, 0); + Store_field(ventry, 0, eio_unix_file_type_of_dtype(d->d_type)); + Store_field(ventry, 1, caml_copy_string_of_os(d->d_name)); + + cons = caml_alloc(2, 0); + Store_field(cons, 0, ventry); // Head + Store_field(cons, 1, result); // Tail result = cons; pos += d->d_reclen; } diff --git a/lib_eio_linux/low_level.ml b/lib_eio_linux/low_level.ml index 42e72bfa3..45cff9215 100644 --- a/lib_eio_linux/low_level.ml +++ b/lib_eio_linux/low_level.ml @@ -362,7 +362,7 @@ external eio_symlinkat : string -> Unix.file_descr -> string -> unit = "caml_eio external eio_getrandom : Cstruct.buffer -> int -> int -> int = "caml_eio_getrandom" -external eio_getdents : Unix.file_descr -> string list = "caml_eio_getdents" +external eio_getdents : Unix.file_descr -> (Eio.File.Stat.kind * string) list = "caml_eio_getdents" let lseek fd off cmd = Fd.use_exn "lseek" fd @@ fun fd -> @@ -513,11 +513,17 @@ let read_dir fd = match eio_getdents fd with | [] -> acc | files -> - let files = List.filter (function ".." | "." -> false | _ -> true) files in + let files = List.filter_map (function (_, "..") | (_, ".") -> None | (_, f) -> Some f) files in read_all (files @ acc) fd in Eio_unix.run_in_systhread ~label:"read_dir" (fun () -> read_all [] fd) +let read_some_dir fd = + Fd.use_exn "read_some_dir" fd @@ fun fd -> + Eio_unix.run_in_systhread ~label:"read_some_dir" @@ fun () -> + let files = eio_getdents fd in + List.filter_map (function _, ".." | _, "." -> None | v -> Some v) files + let read_link fd path = try with_parent_dir_fd fd path @@ fun parent leaf -> diff --git a/lib_eio_linux/low_level.mli b/lib_eio_linux/low_level.mli index 3b8529470..4b0232ffc 100644 --- a/lib_eio_linux/low_level.mli +++ b/lib_eio_linux/low_level.mli @@ -161,6 +161,11 @@ val read_dir : fd -> string list The entries are not returned in any particular order (not even necessarily the order in which Linux returns them). *) +val read_some_dir : fd -> (Eio.File.Stat.kind * string) list +(** [read_some_dir dir] reads some of the directory entries from [dir], including their kind. + The entries are not returned in any particular order + (not even necessarily the order in which Linux returns them). *) + val lseek : fd -> Optint.Int63.t -> [`Set | `Cur | `End] -> Optint.Int63.t (** Set and/or get the current file position. diff --git a/lib_eio_posix/eio_posix_stubs.c b/lib_eio_posix/eio_posix_stubs.c index a3895f48c..73cf0bf16 100644 --- a/lib_eio_posix/eio_posix_stubs.c +++ b/lib_eio_posix/eio_posix_stubs.c @@ -29,6 +29,7 @@ #include #include "fork_action.h" +#include "eio_unix_stubs.h" #ifdef ARCH_SIXTYFOUR #define Int63_val(v) Long_val(v) @@ -559,3 +560,25 @@ CAMLprim value caml_eio_posix_fdopendir(value v_fd) { DIR_Val(v_result) = d; return v_result; } + +CAMLprim value caml_eio_posix_readdir(value v_dir_handle) { + CAMLparam1(v_dir_handle); + CAMLlocal3(v_result, v_kind, v_name); + DIR *dir; + struct dirent *ent; + + dir = DIR_Val(v_dir_handle); + if (!dir) caml_unix_error(EBADF, "readdir", Nothing); + + caml_enter_blocking_section(); + ent = readdir(dir); + caml_leave_blocking_section(); + + if (!ent) caml_raise_end_of_file(); + + v_result = caml_alloc(2, 0); + Store_field(v_result, 0, eio_unix_file_type_of_dtype(ent->d_type)); + Store_field(v_result, 1, caml_copy_string_of_os(ent->d_name)); + + CAMLreturn(v_result); +} diff --git a/lib_eio_posix/fs.ml b/lib_eio_posix/fs.ml index 1a20523a0..d1ba046e5 100644 --- a/lib_eio_posix/fs.ml +++ b/lib_eio_posix/fs.ml @@ -86,6 +86,9 @@ end = struct Err.run (Low_level.readdir t.fd) path |> Array.to_list + let with_dir_entries t path fn = + Err.run (Low_level.with_dir_entries t.fd path) fn + let read_link t path = Err.run (Low_level.read_link t.fd) path diff --git a/lib_eio_posix/low_level.ml b/lib_eio_posix/low_level.ml index 6026993d1..a8c53dd03 100644 --- a/lib_eio_posix/low_level.ml +++ b/lib_eio_posix/low_level.ml @@ -365,6 +365,7 @@ let openat ~sw ~mode fd path flags = | Fd dirfd -> Resolve.open_beneath ~sw ~mode ~dirfd path flags external eio_fdopendir : Unix.file_descr -> Unix.dir_handle = "caml_eio_posix_fdopendir" +external eio_readdir : Unix.dir_handle -> Eio.File.Stat.kind * string = "caml_eio_posix_readdir" let readdir dirfd path = in_worker_thread "readdir" @@ fun () -> @@ -389,6 +390,44 @@ let readdir dirfd path = Fd.use_exn "readdir" dirfd @@ fun dirfd -> use_confined (Some dirfd) +let with_dir_entries dirfd path fn = + let rec read_entry h = + match eio_readdir h with _, "." | _, ".." -> read_entry h | v -> v + in + let it h () = + match in_worker_thread "with_dir_entries" @@ fun () -> read_entry h with + | r -> Some r + | exception End_of_file -> None + | exception ex -> + let bt = Printexc.get_raw_backtrace () in + Unix.closedir h; + Printexc.raise_with_backtrace ex bt + in + let use h = + let seq = Seq.of_dispenser (it h) in + let v = fn seq in + Unix.closedir h; + v + in + let use_confined dirfd = + Resolve.with_parent_loop ?dirfd path @@ fun dirfd path -> + match + eio_openat dirfd path Open_flags.(rdonly + directory + nofollow) 0 + with + | fd -> Ok (use (eio_fdopendir fd)) + | exception + (Unix.Unix_error ((ELOOP | ENOTDIR | EMLINK | EUNKNOWNERR _), _, _) as e) + -> + Error (`Symlink (Some e)) + in + match dirfd with + | Fs -> use (Unix.opendir path) + | Cwd -> use_confined None + | Fd dirfd -> + Fd.use_exn "with_dir_entries" dirfd @@ fun dirfd -> + use_confined (Some dirfd) + + external eio_mkdirat : Unix.file_descr -> string -> Unix.file_perm -> unit = "caml_eio_posix_mkdirat" let mkdir ~mode dirfd path = diff --git a/lib_eio_posix/low_level.mli b/lib_eio_posix/low_level.mli index 69efe7207..afbd1dd42 100644 --- a/lib_eio_posix/low_level.mli +++ b/lib_eio_posix/low_level.mli @@ -83,6 +83,7 @@ val symlink : link_to:string -> dir_fd -> string -> unit linking to [link_to]. *) val readdir : dir_fd -> string -> string array +val with_dir_entries : dir_fd -> string -> ((Eio.File.Stat.kind * string) Seq.t -> 'a) -> 'a val readv : fd -> Cstruct.t array -> int val writev : fd -> Cstruct.t array -> int