From 40c6ba99f51875db28f3e1e8b309812c66594e32 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 7 Jul 2011 21:29:31 -0400
Subject: add: Be even more robust to avoid ever leaving the file seemingly
 deleted.

A failure at any point after the file is annexed will result in an undo
that puts the original file back into place and wipes the location log.
---
 Command/Add.hs | 44 ++++++++++++++++++++++++++++++++++----------
 1 file changed, 34 insertions(+), 10 deletions(-)

(limited to 'Command')

diff --git a/Command/Add.hs b/Command/Add.hs
index e7d16b6c0..5c7cad044 100644
--- a/Command/Add.hs
+++ b/Command/Add.hs
@@ -9,6 +9,10 @@ module Command.Add where
 
 import Control.Monad.State (liftIO)
 import System.Posix.Files
+import System.Directory
+import Control.Exception.Control (handle)
+import Control.Exception.Base (throwIO)
+import Control.Exception.Extensible (IOException)
 
 import Command
 import qualified Annex
@@ -20,6 +24,7 @@ import Content
 import Messages
 import Utility
 import Touch
+import Locations
 
 command :: [Command]
 command = [repoCommand "add" paramPath seek "add files to annex"]
@@ -46,20 +51,39 @@ perform (file, backend) = do
 	case k of
 		Nothing -> stop
 		Just (key, _) -> do
-			moveAnnex key file
+			handle (undo file key) $ moveAnnex key file
 			next $ cleanup file key
 
-cleanup :: FilePath -> Key -> CommandCleanup
-cleanup file key = do
-	link <- calcGitLink file key
-	liftIO $ createSymbolicLink link file
+{- On error, put the file back so it doesn't seem to have vanished.
+ - This can be called before or after the symlink is in place. -}
+undo :: FilePath -> Key -> IOException -> Annex a
+undo file key e = do
+	unlessM (inAnnex key) $ rethrow -- no cleanup to do
+	liftIO $ whenM (doesFileExist file) $ do removeFile file
+	handle tryharder $ fromAnnex key file
+	logStatus key InfoMissing
+	rethrow
+	where
+		rethrow = liftIO $ throwIO e
 
-	logStatus key InfoPresent
+		-- fromAnnex could fail if the file ownership is weird
+		tryharder :: IOException -> Annex ()
+		tryharder _ = do
+			g <- Annex.gitRepo
+			liftIO $ renameFile (gitAnnexLocation g key) file
 
-	-- touch the symlink to have the same mtime as the file it points to
-	s <- liftIO $ getFileStatus file
-	let mtime = modificationTime s
-	liftIO $ touch file (TimeSpec mtime) False
+cleanup :: FilePath -> Key -> CommandCleanup
+cleanup file key = do
+	handle (undo file key) $ do
+		link <- calcGitLink file key
+		liftIO $ createSymbolicLink link file
+		logStatus key InfoPresent
+	
+		-- touch the symlink to have the same mtime as the
+		-- file it points to
+		s <- liftIO $ getFileStatus file
+		let mtime = modificationTime s
+		liftIO $ touch file (TimeSpec mtime) False
 
 	force <- Annex.getState Annex.force
 	if force
-- 
cgit v1.2.3