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
|
`META.pkg.template`. This feature was unused and was making the code
|
||||||
complicated (#370)
|
complicated (#370)
|
||||||
|
|
||||||
|
- Remove read-only attribute on Windows before unlink (#247)
|
||||||
|
|
||||||
1.0+beta16 (05/11/2017)
|
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
|
match Unix.readlink dst with
|
||||||
| target ->
|
| target ->
|
||||||
if target <> src then begin
|
if target <> src then begin
|
||||||
|
(* @@DRA Win32 remove read-only attribute needed when symlinking enabled *)
|
||||||
Unix.unlink dst;
|
Unix.unlink dst;
|
||||||
Unix.symlink src dst
|
Unix.symlink src dst
|
||||||
end
|
end
|
||||||
|
|
22
src/path.ml
22
src/path.ml
|
@ -432,8 +432,24 @@ let is_directory t =
|
||||||
try Sys.is_directory (to_string t)
|
try Sys.is_directory (to_string t)
|
||||||
with Sys_error _ -> false
|
with Sys_error _ -> false
|
||||||
let rmdir t = Unix.rmdir (to_string t)
|
let rmdir t = Unix.rmdir (to_string t)
|
||||||
let unlink t = Unix.unlink (to_string t)
|
let win32_unlink fn =
|
||||||
let unlink_no_err t = try Unix.unlink (to_string t) with _ -> ()
|
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
|
let extend_basename t ~suffix = t ^ suffix
|
||||||
|
|
||||||
|
@ -459,7 +475,7 @@ let rm_rf =
|
||||||
let fn = Filename.concat dir fn in
|
let fn = Filename.concat dir fn in
|
||||||
match Unix.lstat fn with
|
match Unix.lstat fn with
|
||||||
| { st_kind = S_DIR; _ } -> loop fn
|
| { st_kind = S_DIR; _ } -> loop fn
|
||||||
| _ -> Unix.unlink fn);
|
| _ -> unlink_operation fn);
|
||||||
Unix.rmdir dir
|
Unix.rmdir dir
|
||||||
in
|
in
|
||||||
fun t ->
|
fun t ->
|
||||||
|
|
Loading…
Reference in New Issue