Windows: Sys.remove, Unix.unlink now remove symlinks to directories

On Windows, calling `_wunlink` 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(2)` also
forbids deletion of directories.

To emulate that behaviour, we wrap the `_wunlink` call. If it fails
with `EACCES`, we have to check whether the path is a symlink to a
directory. If so, we call `_wrmdir` on it.

[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

We cannot define `unlink_os` to `caml_win32_unlink` as ocamlyacc
includes `caml/misc.h`. It would need the definition from `win32.c`,
which isn't linked in ocamlyacc.

Changes

@@ -86,6 +86,10 @@ Working version
   (Sébastien Hinderer, review by Damien Doligez, Gabriel Scherer, David
   Allsopp, Nicolás Ojeda Bär, Vincent Laviron)
 
+- #10642: On Windows, Sys.remove and Unix.unlink now remove symlinks
+   to directories instead of raising EACCES. (Antonin Décimo, review
+   by David Allsopp, Xavier Leroy)
+
 ### Other libraries:
 
 - #10192: Add support for Unix domain sockets on Windows and use them

otherlibs/unix/unlink.c

@@ -29,7 +29,7 @@ CAMLprim value unix_unlink(value path)
   caml_unix_check_path(path, "unlink");
   p = caml_stat_strdup_to_os(String_val(path));
   caml_enter_blocking_section();
-  ret = unlink_os(p);
+  ret = caml_unlink(p);
   caml_leave_blocking_section();
   caml_stat_free(p);
   if (ret == -1) uerror("unlink", path);

runtime/caml/misc.h

@@ -382,6 +382,13 @@ extern double caml_log1p(double);
 
 #endif /* _WIN32 */
 
+/* Wrapper for Windows unlink */
+#ifdef _WIN32
+#define caml_unlink caml_win32_unlink
+#else
+#define caml_unlink unlink_os
+#endif
+
 
 /* Data structures */
 

runtime/caml/osdeps.h

@@ -111,6 +111,7 @@ extern int caml_num_rows_fd(int fd);
 #ifdef _WIN32
 
 extern int caml_win32_rename(const wchar_t *, const wchar_t *);
+extern int caml_win32_unlink(const wchar_t *);
 
 extern void caml_probe_win32_version(void);
 extern void caml_setup_win32_terminal(void);

runtime/sys.c

@@ -289,7 +289,7 @@ CAMLprim value caml_sys_remove(value name)
   caml_sys_check_path(name);
   p = caml_stat_strdup_to_os(String_val(name));
   caml_enter_blocking_section();
-  ret = unlink_os(p);
+  ret = caml_unlink(p);
   caml_leave_blocking_section();
   caml_stat_free(p);
   if (ret != 0) caml_sys_error(name);

runtime/win32.c

@@ -26,6 +26,7 @@
 #include <wtypes.h>
 #include <winbase.h>
 #include <winsock2.h>
+#include <direct.h>
 #include <stdlib.h>
 #include <stdio.h>
 #include <stdarg.h>
@@ -797,6 +798,29 @@ int caml_win32_rename(const wchar_t * oldpath, const wchar_t * newpath)
   return -1;
 }
 
+int caml_win32_unlink(const wchar_t * path) {
+  int ret, attrs;
+
+  ret = _wunlink(path);
+  /* On Windows, trying to unlink a symlink to a directory will return
+   * EACCES, but the symlink can be deleted with rmdir. */
+  if (ret == -1 && errno == EACCES) {
+    WIN32_FIND_DATAW data;
+    HANDLE h = FindFirstFileExW(path, FindExInfoStandard, &data,
+                                FindExSearchNameMatch, NULL, 0);
+    if (h != INVALID_HANDLE_VALUE &&
+        (data.dwFileAttributes & FILE_ATTRIBUTE_REPARSE_POINT) &&
+        (data.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) &&
+        data.dwReserved0 == IO_REPARSE_TAG_SYMLINK) {
+      FindClose(h);
+      ret = _wrmdir(path);
+      if (ret == -1)
+        errno = EACCES;
+    }
+  }
+  return ret;
+}
+
 /* Windows Unicode support */
 static uintnat windows_unicode_enabled = WINDOWS_UNICODE;
 

testsuite/tests/lib-unix/win-symlink/test.ml

@@ -35,7 +35,9 @@ let main () =
   did_raise := false;
   if not (directory_exists dir) then
     Unix.mkdir dir 0o644;
-  begin try Unix.unlink dir with Unix.Unix_error((EISDIR (* Linux *) | EPERM (* POSIX *)), _, _) -> did_raise := true end;
+  begin try Unix.unlink dir with
+  | Unix.Unix_error((EISDIR (* Linux *) | EPERM (* POSIX *) | EACCES (* Windows *)), _, _) ->
+    did_raise := true end;
   assert (!did_raise);
   assert (directory_exists dir);
   print_endline "Unix.unlink cannot delete directories";