From eef3f634e9f92e7af486e5ee4afdac9a79b034cf Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 28 Apr 2011 20:41:40 -0400
Subject: Avoid crashing when an existing key is readded to the annex.

---
 Content.hs | 37 ++++++++++++++++++++++++++++++-------
 1 file changed, 30 insertions(+), 7 deletions(-)

(limited to 'Content.hs')

diff --git a/Content.hs b/Content.hs
index 99770f553..ade936da3 100644
--- a/Content.hs
+++ b/Content.hs
@@ -182,18 +182,41 @@ allowWrite f = do
 	s <- getFileStatus f
 	setFileMode f $ fileMode s `unionFileModes` ownerWriteMode
 
-{- Moves a file into .git/annex/objects/ -}
+{- Moves a file into .git/annex/objects/
+ -
+ - What if the key there already has content? This could happen for
+ - various reasons; perhaps the same content is being annexed again.
+ - Perhaps there has been a hash collision generating the keys.
+ -
+ - The current strategy is to assume that in this case it's safe to delete
+ - one of the two copies of the content; and the one already in the annex
+ - is left there, assuming it's the original, canonical copy.
+ -
+ - I considered being more paranoid, and checking that both files had
+ - the same content. Decided against it because A) users explicitly choose
+ - a backend based on its hashing properties and so if they're dealing
+ - with colliding files it's their own fault and B) adding such a check
+ - would not catch all cases of colliding keys. For example, perhaps 
+ - a remote has a key; if it's then added again with different content then
+ - the overall system now has two different peices of content for that
+ - key, and one of them will probably get deleted later. So, adding the
+ - check here would only raise expectations that git-annex cannot truely
+ - meet.
+ -}
 moveAnnex :: Key -> FilePath -> Annex ()
 moveAnnex key src = do
 	g <- Annex.gitRepo
 	let dest = gitAnnexLocation g key
 	let dir = parentDir dest
-	liftIO $ do
-		createDirectoryIfMissing True dir
-		allowWrite dir -- in case the directory already exists
-		renameFile src dest
-		preventWrite dest
-		preventWrite dir
+	e <- liftIO $ doesFileExist dest
+	if e
+		then liftIO $ removeFile src
+		else liftIO $ do
+			createDirectoryIfMissing True dir
+			allowWrite dir -- in case the directory already exists
+			renameFile src dest
+			preventWrite dest
+			preventWrite dir
 
 {- Removes a key's file from .git/annex/objects/ -}
 removeAnnex :: Key -> Annex ()
-- 
cgit v1.2.3