Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Remove readonly attribute on Windows before unlink #247

Merged
merged 1 commit into from
Jan 22, 2018
Merged
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions CHANGES.md
Original file line number Diff line number Diff line change
@@ -65,6 +65,8 @@ next
`META.pkg.template`. This feature was unused and was making the code
complicated (#370)

- Remove read-only attribute on Windows before unlink (#247)

1.0+beta16 (05/11/2017)
-----------------------

1 change: 1 addition & 0 deletions src/action.ml
Original file line number Diff line number Diff line change
@@ -735,6 +735,7 @@ let rec exec t ~ectx ~dir ~env_extra ~stdout_to ~stderr_to =
match Unix.readlink dst with
| target ->
if target <> src then begin
(* @@DRA Win32 remove read-only attribute needed when symlinking enabled *)
Unix.unlink dst;
Unix.symlink src dst
end
22 changes: 19 additions & 3 deletions src/path.ml
Original file line number Diff line number Diff line change
@@ -432,8 +432,24 @@ let is_directory t =
try Sys.is_directory (to_string t)
with Sys_error _ -> false
let rmdir t = Unix.rmdir (to_string t)
let unlink t = Unix.unlink (to_string t)
let unlink_no_err t = try Unix.unlink (to_string t) with _ -> ()
let win32_unlink fn =
try
Unix.unlink fn
with Unix.Unix_error (Unix.EACCES, _, _) as e ->
(* Try removing the read-only attribute *)
try
Unix.chmod fn 0o666;
Unix.unlink fn
with _ ->
raise e
let unlink_operation =
if Sys.win32 then
win32_unlink
else
Unix.unlink
let unlink t =
unlink_operation (to_string t)
let unlink_no_err t = try unlink t with _ -> ()

let extend_basename t ~suffix = t ^ suffix

@@ -459,7 +475,7 @@ let rm_rf =
let fn = Filename.concat dir fn in
match Unix.lstat fn with
| { st_kind = S_DIR; _ } -> loop fn
| _ -> Unix.unlink fn);
| _ -> unlink_operation fn);
Unix.rmdir dir
in
fun t ->