diff --git a/src/action.ml b/src/action.ml index 6fc9cbf28ff7..ccf2beff3c2a 100644 --- a/src/action.ml +++ b/src/action.ml @@ -560,6 +560,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 a260a4cd0758..e6d44ece9423 100644 --- a/src/path.ml +++ b/src/path.ml @@ -373,8 +373,24 @@ let exists t = Sys.file_exists (to_string t) let readdir t = Sys.readdir (to_string t) |> Array.to_list let is_directory t = Sys.is_directory (to_string t) 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 @@ -403,7 +419,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 ->