add: Improved detection of files that are modified while being added.

In indirect mode, now checks the inode cache to detect changes to a file.
Note that a file can still be changed if a process has it open for write,
after landing in the annex.

In direct mode, some checking of the inode cache was done before, but
from a much later point, so fewer modifications could be detected. Now it's
as good as indirect mode.

On crippled filesystems, no lock down is done before starting to add a
file, so checking the inode cache is the only protection we have.

1 files changed, 34 insertions, 25 deletions

diff --git a/Command/Add.hs b/Command/Add.hs
index 7fff5e778..9cd5ec87b 100644
--- a/Command/Add.hs
+++ b/Command/Add.hs
@@ -28,6 +28,7 @@ import Config
 import qualified Git.HashObject
 import qualified Git.UpdateIndex
 import Git.Types
+import Utility.InodeCache
 
 def :: [Command]
 def = [notBareRepo $ command "add" paramPaths seek "add files to annex"]
@@ -68,8 +69,13 @@ start file = ifAnnexed file fixup add
  -}
 lockDown :: FilePath -> Annex (Maybe KeySource)
 lockDown file = ifM (crippledFileSystem)
-	( return $ Just $
-		KeySource { keyFilename = file, contentLocation = file }
+	( liftIO $ catchMaybeIO $ do
+		cache <- genInodeCache file
+		return $ KeySource
+			{ keyFilename = file
+			, contentLocation = file
+			, inodeCache = cache
+			}
 	, do
 		tmp <- fromRepo gitAnnexTmpDir
 		createAnnexDirectory tmp
@@ -79,7 +85,12 @@ lockDown file = ifM (crippledFileSystem)
 			hClose h
 			nukeFile tmpfile
 			createLink file tmpfile
-			return $ KeySource { keyFilename = file , contentLocation = tmpfile }
+			cache <- genInodeCache tmpfile
+			return $ KeySource
+				{ keyFilename = file
+				, contentLocation = tmpfile
+				, inodeCache = cache
+				}
 	)
 
 {- Ingests a locked down file into the annex.
@@ -91,33 +102,31 @@ ingest :: (Maybe KeySource) -> Annex (Maybe Key)
 ingest Nothing = return Nothing
 ingest (Just source) = do
 	backend <- chooseBackend $ keyFilename source
-	ifM isDirect
-		( do
-			mstat <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus $ keyFilename source
-			k <- genKey source backend
-			godirect k (toInodeCache =<< mstat)
-		, go =<< genKey source backend
-		)
+	k <- genKey source backend
+	cache <- liftIO $ genInodeCache $ contentLocation source
+	case inodeCache source of
+		Nothing -> go k cache
+		Just c
+			| (Just c == cache) -> go k cache
+			| otherwise -> failure
   where
-	go (Just (key, _)) = do
+	go k cache = ifM isDirect ( godirect k cache , goindirect k cache )
+
+	goindirect (Just (key, _)) _ = do
 		handle (undo (keyFilename source) key) $
 			moveAnnex key $ contentLocation source
 		liftIO $ nukeFile $ keyFilename source
 		return $ Just key
-	go Nothing = failure
-
-	godirect (Just (key, _)) (Just cache) =
-		ifM (liftIO $ compareInodeCache (keyFilename source) $ Just cache)
-			( do
-				writeInodeCache key cache
-				void $ addAssociatedFile key $ keyFilename source
-				unlessM crippledFileSystem $
-					liftIO $ allowWrite $ keyFilename source
-				when (contentLocation source /= keyFilename source) $
-					liftIO $ nukeFile $ contentLocation source
-				return $ Just key
-			, failure
-			)
+	goindirect Nothing _ = failure
+
+	godirect (Just (key, _)) (Just cache) = do
+		writeInodeCache key cache
+		void $ addAssociatedFile key $ keyFilename source
+		unlessM crippledFileSystem $
+			liftIO $ allowWrite $ keyFilename source
+		when (contentLocation source /= keyFilename source) $
+			liftIO $ nukeFile $ contentLocation source
+		return $ Just key
 	godirect _ _ = failure
 
 	failure = do