Remove readonly attribute on Windows before unlink
The legacy DOS readonly attribute is a tedious difference on Windows, because a user may have permission to delete a file, but unlink fails because the attribute is set. Signed-off-by: David Allsopp <david.allsopp@metastack.com>
This commit is contained in:
parent
b401284b84
commit
d2706b448b
|
@ -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)
|
||||
-----------------------
|
||||
|
||||
|
|
|
@ -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
src/path.ml
22
src/path.ml
|
@ -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 ->
|
||||
|
|
Loading…
Reference in New Issue