Skip to content

Commit

Permalink
Try removing the RO bit when unlinking files on Windows (#849)
Browse files Browse the repository at this point in the history
* Try removing the RO bit when unlinking files on Windows

On Windows, some programs may set the read-only bit on files. For
instance, git marks its index files as read-only. Calling
`Unix.unlink` on such a file will result in an
`Unix.Unix_error(Unix.EACCES, "unlink", _)` exception.

`Lwt_io.with_temp_dir` creates a temporary directory in which it is
possible that a read-only file is created. In such case, the
`delete_recursively` function will not be able to clean the temporary
directory and will also raise an exception.

This patch allows by setting the file writable (removing the RO bit)
to delete the file.

This code was copied from Dune:
https://github.com/ocaml/dune/blob/ed361ebc4f37a81d3e6ffc905b0d45f61bc17e9c/otherlibs/stdune-unstable/fpath.ml#L74-L88

* Use Lwt.catch instead of try-with and restore perms if unlink fails
  • Loading branch information
MisterDA authored May 3, 2021
1 parent 2685ce0 commit 9cbf3a9
Showing 1 changed file with 23 additions and 1 deletion.
24 changes: 23 additions & 1 deletion src/unix/lwt_io.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1470,6 +1470,28 @@ let create_temp_dir
in
attempt 0

let win32_unlink fn =
Lwt.catch
(fun () -> Lwt_unix.unlink fn)
(function
| Unix.Unix_error (Unix.EACCES, _, _) ->
Lwt_unix.lstat fn >>= fun {st_perm; _} ->
(* Try removing the read-only attribute *)
Lwt_unix.chmod fn 0o666 >>= fun () ->
Lwt.catch
(fun () -> Lwt_unix.unlink fn)
(function exn ->
(* Restore original permissions *)
Lwt_unix.chmod fn st_perm >>= fun () ->
Lwt.fail exn)
| exn -> Lwt.fail exn)

let unlink =
if Sys.win32 then
win32_unlink
else
Lwt_unix.unlink

(* This is likely VERY slow for directories with many files. That is probably
best addressed by switching to blocking calls run inside a worker thread,
i.e. with Lwt_preemptive. *)
Expand All @@ -1485,7 +1507,7 @@ let rec delete_recursively directory =
if stat.Lwt_unix.st_kind = Lwt_unix.S_DIR then
delete_recursively path
else
Lwt_unix.unlink path
unlink path
end >>= fun () ->
Lwt_unix.rmdir directory

Expand Down

0 comments on commit 9cbf3a9

Please sign in to comment.