diff --git a/CHANGES.md b/CHANGES.md index 4a3802ba..357f02e7 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -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) ----------------------- diff --git a/src/action.ml b/src/action.ml index 8a29d9b7..82b680ec 100644 --- a/src/action.ml +++ b/src/action.ml @@ -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 diff --git a/src/path.ml b/src/path.ml index 926b66af..b25d399a 100644 --- a/src/path.ml +++ b/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 ->