direct: Fix handling of case where a work tree subdirectory cannot be written to due to permissions.

Running `git annex direct` would cause loss of data, because the object
was moved to a temp file, which it then tried to replace the work tree file
with, and on failure, the temp file got deleted. Now it's instead moved
back into the annex object location.

1 files changed, 8 insertions, 3 deletions

diff --git a/Annex/ReplaceFile.hs b/Annex/ReplaceFile.hs
index 8b15f5ce3..e734c4d64 100644
--- a/Annex/ReplaceFile.hs
+++ b/Annex/ReplaceFile.hs
@@ -23,11 +23,16 @@ import Annex.Exception
  - Throws an IO exception when it was unable to replace the file.
  -}
 replaceFile :: FilePath -> (FilePath -> Annex ()) -> Annex ()
-replaceFile file a = do
+replaceFile file action = replaceFileOr file action (liftIO . nukeFile)
+
+{- If unable to replace the file with the temp file, runs the
+ - rollback action, which is responsible for cleaning up the temp file. -}
+replaceFileOr :: FilePath -> (FilePath -> Annex ()) -> (FilePath -> Annex ()) -> Annex ()
+replaceFileOr file action rollback = do
 	tmpdir <- fromRepo gitAnnexTmpMiscDir
 	void $ createAnnexDirectory tmpdir
-	bracketIO (setup tmpdir) nukeFile $ \tmpfile -> do
-		a tmpfile
+	bracketAnnex (liftIO $ setup tmpdir) rollback $ \tmpfile -> do
+		action tmpfile
 		liftIO $ catchIO (rename tmpfile file) (fallback tmpfile)
   where
   	setup tmpdir = do