Windows: add rename support

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)

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
 

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]

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;
 ]