Windows: fix POSIX compliance of Sys.remove and Unix.unlink

This patch fixes two issues:
- Sys.remove and Unix.unlink would not remove symlinks to directories;
- Sys.remove and Unix.unlink would return EACCES error instead of
  EPERM when trying to delete directories.

This patch fixes them both and brings the Windows implementation up to
POSIX compliance, which requires the two behaviours above.

On Windows, calling _unlink on a path may fail with EACCES if [1]:
1. the path specifies a read-only file;
2. the path specifies a directory.

Symlinks to directories "count" as directories themselves, so _unlink
will fail on them. However, POSIX unlink(2) specifies [2] that it will
gladly unlink symlinks to directories. POSIX unlink also forbids
deletion of directories.

To emulate that behaviour, we wrap the unlink call. If it fails with
EACCES, we have to check whether the path is a symlink. If so, we call
rmdir on it. If the path is a directory, we return EPERM. If not, we
return the original error.

[1]: https://docs.microsoft.com/en-us/cpp/c-runtime-library/reference/unlink-wunlink?view=msvc-160
[2]: https://pubs.opengroup.org/onlinepubs/9699919799/functions/unlink.html

Changes

@@ -71,6 +71,9 @@ Working version
   (Nicolás Ojeda Bär, review by John Whitington, Daniel Bünzli, David Allsopp
   and Xavier Leroy)
 
+- #10642: On Windows, Sys.remove now correctly handles removal of
+  symlinks to directories. (Antonin Décimo, review by David Allsopp)
+
 ### Other libraries:
 
 - #10192: Add support for Unix domain sockets on Windows and use them
@@ -81,6 +84,11 @@ Working version
   Thread.default_uncaught_exception_handler.
   (Enguerrand Decorne, review by David Allsopp)
 
+- #10642: On Windows, Unix.unlink now raises EPERM when trying to
+  unlink a directory (compliance with POSIX). Wrap unlink to correctly
+  handle the unlinking of symlinks to directories. (Antonin Décimo,
+  review by David Allsopp)
+
 ### Tools:
 
 - #3959, #7202, #10476: ocaml, in script mode, directive errors

otherlibs/unix/unix.mli

@@ -616,9 +616,9 @@ val unlink : string -> unit
 
     If the named file is a directory, raises:
     {ul
-    {- [EPERM] on POSIX compliant system}
+    {- [EPERM] on POSIX compliant system, and Windows (since 4.14.0)}
     {- [EISDIR] on Linux >= 2.1.132}
-    {- [EACCESS] on Windows}}
+    {- [EACCESS] on Windows (until 4.14.0)}}
 *)
 
 val rename : string -> string -> unit

otherlibs/unix/unixLabels.mli

@@ -616,9 +616,9 @@ val unlink : string -> unit
 
     If the named file is a directory, raises:
     {ul
-    {- [EPERM] on POSIX compliant system}
+    {- [EPERM] on POSIX compliant system, and Windows (since 4.14.0)}
     {- [EISDIR] on Linux >= 2.1.132}
-    {- [EACCESS] on Windows}}
+    {- [EACCESS] on Windows (until 4.14.0)}}
 *)
 
 val rename : src:string -> dst:string -> unit

otherlibs/win32unix/unix.ml

@@ -361,6 +361,7 @@ external isatty : file_descr -> bool = "unix_isatty"
 
 (* Operations on file names *)
 
+(* Unlink is redefined after rmdir definition. *)
 external unlink : string -> unit = "unix_unlink"
 external rename : string -> string -> unit = "unix_rename"
 external link : ?follow:bool -> string -> string -> unit = "unix_link"
@@ -457,6 +458,21 @@ external chdir : string -> unit = "unix_chdir"
 external getcwd : unit -> string = "unix_getcwd"
 let chroot _ = invalid_arg "Unix.chroot not implemented"
 
+let unlink path =
+  (* On Windows, trying to unlink a symlink to a directory will
+     raise, but the symlink can be deleted with rmdir. *)
+  try unlink path with
+  | Unix_error (EACCES, _, _) as exn_unlink ->
+    let {st_kind; _} = try lstat path with _ -> raise exn_unlink in
+    begin match st_kind with
+    | S_DIR ->
+      (* POSIX uses EPERM rather than EACCES when the path is a
+       * directory. *)
+      raise (Unix_error (EPERM, path, error_message EPERM))
+    | S_LNK -> rmdir path
+    | _ -> raise exn_unlink
+    end
+
 type dir_entry =
     Dir_empty
   | Dir_read of string

runtime/sys.c

@@ -27,6 +27,8 @@
 #include <sys/types.h>
 #include <sys/stat.h>
 #ifdef _WIN32
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h> /* for GetFileAttributes and flags */
 #include <direct.h> /* for _wchdir and _wgetcwd */
 #else
 #include <sys/wait.h>
@@ -286,10 +288,34 @@ CAMLprim value caml_sys_remove(value name)
   CAMLparam1(name);
   char_os * p;
   int ret;
+
   caml_sys_check_path(name);
   p = caml_stat_strdup_to_os(String_val(name));
   caml_enter_blocking_section();
   ret = unlink_os(p);
+#ifdef _WIN32
+  /* On Windows, trying to unlink a symlink to a directory will return
+   * EACCES, but the symlink can be deleted with rmdir. */
+  if (ret != 0 && errno == EACCES) {
+    if ((ret = GetFileAttributes(p)) != INVALID_FILE_ATTRIBUTES) {
+      if ((ret & FILE_ATTRIBUTE_REPARSE_POINT) &&
+          (ret & FILE_ATTRIBUTE_DIRECTORY)) {
+        ret = rmdir_os(p);
+      } else if (ret & FILE_ATTRIBUTE_DIRECTORY) {
+        /* POSIX uses EPERM rather than EACCES when the path is a
+         * directory. */
+        errno = EPERM;
+        ret = -1;
+      } else {
+        errno = EACCES;
+        ret = -1;
+      }
+    } else {
+      errno = EACCES;
+      ret = -1;
+    }
+  }
+#endif
   caml_leave_blocking_section();
   caml_stat_free(p);
   if (ret != 0) caml_sys_error(name);