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

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_os` call. If it fails
with `EACCES`, we have to check whether the path is a symlink to a
directory. If so, we call `rmdir_os` 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

@@ -71,8 +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)
+- #10642: On Windows, Sys.remove now removes symlinks to directories
+   instead of raising EACCES. (Antonin Décimo, review by David
+   Allsopp)
 
 ### Other libraries:
 
@@ -84,10 +85,9 @@ 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)
+- #10642: On Windows, Unix.unlink now removes symlinks to directories
+   instead of raising EACCES. (Antonin Décimo, review by David
+   Allsopp)
 
 ### Tools:
 

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, and Windows (since 4.14.0)}
+    {- [EPERM] on POSIX compliant system}
     {- [EISDIR] on Linux >= 2.1.132}
-    {- [EACCESS] on Windows (until 4.14.0)}}
+    {- [EACCESS] on Windows}}
 *)
 
 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, and Windows (since 4.14.0)}
+    {- [EPERM] on POSIX compliant system}
     {- [EISDIR] on Linux >= 2.1.132}
-    {- [EACCESS] on Windows (until 4.14.0)}}
+    {- [EACCESS] on Windows}}
 *)
 
 val rename : src:string -> dst:string -> unit

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

otherlibs/win32unix/unix.ml

@@ -361,7 +361,6 @@ 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"
@@ -458,21 +457,6 @@ 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/caml/misc.h

@@ -356,6 +356,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

@@ -27,8 +27,6 @@
 #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>
@@ -288,34 +286,10 @@ 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
+  ret = caml_unlink(p);
   caml_leave_blocking_section();
   caml_stat_free(p);
   if (ret != 0) caml_sys_error(name);

runtime/win32.c

@@ -797,6 +797,24 @@ 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 = unlink_os(p);
+  /* 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) {
+    if ((attrs = GetFileAttributes(p)) != INVALID_FILE_ATTRIBUTES &&
+        (attrs & FILE_ATTRIBUTE_REPARSE_POINT) &&
+        (attrs & FILE_ATTRIBUTE_DIRECTORY)) {
+      ret = rmdir_os(p);
+      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";