diff --git a/lib_eio_windows/eio_windows_stubs.c b/lib_eio_windows/eio_windows_stubs.c index 1f45acbbc..4d03e1f38 100755 --- a/lib_eio_windows/eio_windows_stubs.c +++ b/lib_eio_windows/eio_windows_stubs.c @@ -267,9 +267,78 @@ CAMLprim value caml_eio_windows_unlinkat(value v_dirfd, value v_pathname, value CAMLreturn(Val_unit); } +/* Missing from mingw's winternl.h but fixed by Windows kernel ABI */ +#define FileRenameInformationEx ((FILE_INFORMATION_CLASS)65) + CAMLprim value caml_eio_windows_renameat(value v_old_fd, value v_old_path, value v_new_fd, value v_new_path) { - uerror("renameat is not supported on windows yet", Nothing); + CAMLparam4(v_old_fd, v_old_path, v_new_fd, v_new_path); + HANDLE h, old_dir, new_dir; + OBJECT_ATTRIBUTES obj_attr; + IO_STATUS_BLOCK io_status; + UNICODE_STRING relative; + wchar_t *old_path, *new_path; + FILE_RENAME_INFO *info; + size_t name_len, info_size; + NTSTATUS r; + + pNtCreateFile NtCreatefile = (pNtCreateFile)GetProcAddress(GetModuleHandle("ntdll.dll"), "NtCreateFile"); + caml_unix_check_path(v_old_path, "renameat"); + caml_unix_check_path(v_new_path, "renameat"); + old_dir = Is_some(v_old_fd) ? Handle_val(Some_val(v_old_fd)) : NULL; + new_dir = Is_some(v_new_fd) ? Handle_val(Some_val(v_new_fd)) : NULL; + + old_path = caml_stat_strdup_to_utf16(String_val(v_old_path)); + RtlInitUnicodeString(&relative, old_path); + InitializeObjectAttributes(&obj_attr, &relative, OBJ_CASE_INSENSITIVE, old_dir, NULL); + caml_enter_blocking_section(); + r = NtCreatefile( + &h, + DELETE | SYNCHRONIZE, + &obj_attr, + &io_status, + 0, + FILE_ATTRIBUTE_NORMAL, + (FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE), + FILE_OPEN, + (FILE_SYNCHRONOUS_IO_NONALERT | FILE_OPEN_FOR_BACKUP_INTENT | FILE_OPEN_REPARSE_POINT), + NULL, + 0 + ); + caml_leave_blocking_section(); + caml_stat_free(old_path); + if (!NT_SUCCESS(r)) { + caml_win32_maperr(RtlNtStatusToDosError(r)); + uerror("renameat", v_old_path); + } + + new_path = caml_stat_strdup_to_utf16(String_val(v_new_path)); + name_len = wcslen(new_path) * sizeof(wchar_t); + info_size = sizeof(FILE_RENAME_INFO) + name_len; + info = caml_stat_alloc(info_size); + info->Flags = FILE_RENAME_FLAG_REPLACE_IF_EXISTS | FILE_RENAME_FLAG_POSIX_SEMANTICS; + info->RootDirectory = new_dir; + info->FileNameLength = (ULONG)name_len; + memcpy(info->FileName, new_path, name_len); + caml_stat_free(new_path); + + caml_enter_blocking_section(); + r = NtSetInformationFile(h, &io_status, info, (ULONG)info_size, FileRenameInformationEx); + if (r == STATUS_INVALID_PARAMETER || r == STATUS_INVALID_INFO_CLASS) { + /* FAT32 volumes only seem to have the original class afaict */ + info->Flags = 0; + info->ReplaceIfExists = TRUE; + r = NtSetInformationFile(h, &io_status, info, (ULONG)info_size, FileRenameInformation); + } + CloseHandle(h); + caml_leave_blocking_section(); + caml_stat_free(info); + if (!NT_SUCCESS(r)) { + caml_win32_maperr(RtlNtStatusToDosError(r)); + uerror("renameat", v_new_path); + } + + CAMLreturn(Val_unit); } CAMLprim value caml_eio_windows_symlinkat(value v_old_path, value v_new_fd, value v_new_path) diff --git a/lib_eio_windows/low_level.ml b/lib_eio_windows/low_level.ml index 3d087c311..d23f7bbc3 100755 --- a/lib_eio_windows/low_level.ml +++ b/lib_eio_windows/low_level.ml @@ -264,6 +264,7 @@ external eio_renameat : Unix.file_descr option -> string -> Unix.file_descr opti let rename ?old_dir old_path ?new_dir new_path = with_dirfd "rename-old" old_dir @@ fun old_dir -> with_dirfd "rename-new" new_dir @@ fun new_dir -> + let old_path = nt_path old_dir old_path and new_path = nt_path new_dir new_path in in_worker_thread ~label:"rename" @@ fun () -> eio_renameat old_dir old_path new_dir new_path diff --git a/lib_eio_windows/low_level.mli b/lib_eio_windows/low_level.mli index 429c75563..6688861aa 100755 --- a/lib_eio_windows/low_level.mli +++ b/lib_eio_windows/low_level.mli @@ -52,6 +52,9 @@ val mkdir : ?dirfd:fd -> ?follow:follow -> mode:int -> string -> unit val unlink : ?dirfd:fd -> dir:bool -> string -> unit val rename : ?old_dir:fd -> string -> ?new_dir:fd -> string -> unit +(** [rename ?old_dir old ?new_dir new] moves [old] to [new], replacing an + existing file or empty directory. Some volumes such as FAT cannot + replace a directory and will fail. *) val symlink : link_to:string -> fd option -> string -> unit (** [symlink ~link_to dir path] will create a new symlink at [dir / path] diff --git a/lib_eio_windows/test/test_fs.ml b/lib_eio_windows/test/test_fs.ml index 5bfa159f4..928032553 100755 --- a/lib_eio_windows/test/test_fs.ml +++ b/lib_eio_windows/test/test_fs.ml @@ -503,6 +503,46 @@ let test_stat_symlink env () = (* Windows stores the target path in UTF-16 *) Alcotest.(check int) "size is that of the target path" (2 * String.length target) (Optint.Int63.to_int size) +let test_rename env () = + let cwd = Eio.Stdenv.cwd env in + let fs = Eio.Stdenv.fs env in + with_cleanup ["rn-a"; "rn-b"; "rn-c"; "rn-dir\\moved"; "rn-dir2\\moved"; "rn-dir"; "rn-dir2"; "..\\rn-escaped"] @@ fun () -> + Path.save ~create:(`Exclusive 0o600) (cwd / "rn-a") "a"; + Path.rename (cwd / "rn-a") (cwd / "rn-b"); + Alcotest.(check string) "renamed" "a" (read_file "rn-b"); + Alcotest.(check bool) "old name gone" false (Sys.file_exists "rn-a"); + write_file "rn-c" "c"; + Path.rename (cwd / "rn-b") (cwd / "rn-c"); + Alcotest.(check string) "existing target replaced" "a" (read_file "rn-c"); + try_mkdir (cwd / "rn-dir"); + Path.rename (cwd / "rn-c") (cwd / "rn-dir" / "moved"); + Alcotest.(check string) "moved into a directory" "a" (read_file "rn-dir\\moved"); + Path.rename (cwd / "rn-dir") (cwd / "rn-dir2"); + Alcotest.(check bool) "directory renamed" true (Sys.is_directory "rn-dir2"); + let abs = Filename.concat (Sys.getcwd ()) in + Path.rename (fs / abs "rn-dir2\\moved") (fs / abs "rn-a"); + Alcotest.(check string) "renamed through fs" "a" (read_file "rn-a"); + match Path.rename (cwd / "rn-a") (cwd / "..\\rn-escaped") with + | () -> Alcotest.fail "Expected permission denied" + | exception Eio.Io (Eio.Fs.E (Permission_denied _), _) -> () + +let test_rename_over_dir env () = + let cwd = Eio.Stdenv.cwd env in + with_cleanup ["rn-src\\inside"; "rn-src"; "rn-empty\\inside"; "rn-empty"; "rn-full\\inside"; "rn-full"] @@ fun () -> + try_mkdir (cwd / "rn-src"); + write_file "rn-src\\inside" "x"; + try_mkdir (cwd / "rn-empty"); + Path.rename (cwd / "rn-src") (cwd / "rn-empty"); + Alcotest.(check string) "empty directory replaced" "x" (read_file "rn-empty\\inside"); + Alcotest.(check bool) "old name gone" false (Sys.file_exists "rn-src"); + try_mkdir (cwd / "rn-full"); + write_file "rn-full\\inside" "y"; + match Path.rename (cwd / "rn-empty") (cwd / "rn-full") with + | () -> Alcotest.fail "Expected ENOTEMPTY" + | exception Eio.Io (Eio.Exn.X (Eio_unix.Unix_error (Unix.ENOTEMPTY, _, _)), _) -> + Alcotest.(check string) "non-empty directory kept" "y" (read_file "rn-full\\inside"); + Alcotest.(check string) "source kept" "x" (read_file "rn-empty\\inside") + let tests env = [ "create-write-read", `Quick, test_create_and_read env; "absolute-join", `Quick, test_absolute_join env; @@ -535,4 +575,6 @@ let tests env = [ "stat-directory", `Quick, test_stat_directory env; "stat-regular-file", `Quick, test_stat_regular_file env; "stat-symlink", `Quick, test_stat_symlink env; + "rename", `Quick, test_rename env; + "rename-over-directory", `Quick, test_rename_over_dir env; ]