make linkAnnex detect when the file changes as it's being copied/linked in

This fixes a race where the modified file ended up in annex/objects, and
the InodeCache stored in the database was for the modified version, so
git-annex didn't know it had gotten modified.

The race could occur when the smudge filter was running; now it gets the
InodeCache before generating the Key, which avoids the race.

4 files changed, 39 insertions, 17 deletions

diff --git a/Annex/Content.hs b/Annex/Content.hs
index 4cd2b0259..c00863e31 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -521,30 +521,43 @@ populatePointerFile k obj f = go =<< isPointerFile f
  - prevent losing the content if the source file is deleted, but does not
  - guard against modifications.
  -}
-linkAnnex :: Key -> FilePath -> Annex LinkAnnexResult
-linkAnnex key src = do
+linkAnnex :: Key -> FilePath -> Maybe InodeCache -> Annex LinkAnnexResult
+linkAnnex key src srcic = do
 	dest <- calcRepo (gitAnnexLocation key)
-	modifyContent dest $ linkAnnex' key src dest
+	modifyContent dest $ linkAnnex' key src srcic dest
 
 {- Hard links (or copies) src to dest, one of which should be the
  - annex object. Updates inode cache for src and for dest when it's
  - changed. -}
-linkAnnex' :: Key -> FilePath -> FilePath -> Annex LinkAnnexResult
-linkAnnex' key src dest = 
+linkAnnex' :: Key -> FilePath -> Maybe InodeCache -> FilePath -> Annex LinkAnnexResult
+linkAnnex' _ _ Nothing _ = return LinkAnnexFailed
+linkAnnex' key src (Just srcic) dest = 
 	ifM (liftIO $ doesFileExist dest)
 		( do
-			Database.Keys.storeInodeCaches key [src]
+			Database.Keys.addInodeCaches key [srcic]
 			return LinkAnnexNoop
 		, ifM (linkAnnex'' key src dest)
 			( do
 				thawContent dest
-				Database.Keys.storeInodeCaches key [dest, src]
-				return LinkAnnexOk
-			, do
-				Database.Keys.storeInodeCaches key [src]
-				return LinkAnnexFailed
+				-- src could have changed while being copied
+				-- to dest
+				mcache <- withTSDelta (liftIO . genInodeCache src)
+				case mcache of
+					Just srcic' | compareStrong srcic srcic' -> do
+						destic <- withTSDelta (liftIO . genInodeCache dest)
+						Database.Keys.addInodeCaches key $
+							catMaybes [destic, Just srcic]
+						return LinkAnnexOk
+					_ -> do
+						liftIO $ nukeFile dest
+						failed
+			, failed
 			)
 		)
+  where
+	failed = do
+		Database.Keys.addInodeCaches key [srcic]
+		return LinkAnnexFailed
 
 data LinkAnnexResult = LinkAnnexOk | LinkAnnexFailed | LinkAnnexNoop
 
diff --git a/Command/Smudge.hs b/Command/Smudge.hs
index e6541bc6d..2876326b8 100644
--- a/Command/Smudge.hs
+++ b/Command/Smudge.hs
@@ -14,6 +14,7 @@ import Annex.Link
 import Annex.MetaData
 import Annex.FileMatcher
 import Annex.InodeSentinal
+import Utility.InodeCache
 import Types.KeySource
 import Backend
 import Logs.Location
@@ -86,7 +87,7 @@ clean file = do
 
 -- If the file being cleaned was hard linked to the old key's annex object,
 -- modifying the file will have caused the object to have the wrong content.
--- Clean up from that, making the 
+-- Clean up from that.
 cleanOldKey :: FilePath -> Key -> Annex ()
 cleanOldKey modifiedfile key = do
 	obj <- calcRepo (gitAnnexLocation key)
@@ -99,7 +100,9 @@ cleanOldKey modifiedfile key = do
 		case fs' of
 			-- If linkAnnex fails, the file with the content
 			-- is still present, so no need for any recovery.
-			(f:_) -> void $ linkAnnex key f
+			(f:_) -> do
+				ic <- withTSDelta (liftIO . genInodeCache f)
+				void $ linkAnnex key f ic
 			_ -> lostcontent
   where
 	lostcontent = logStatus key InfoMissing
@@ -112,17 +115,18 @@ shouldAnnex file = do
 ingest :: FilePath -> Annex Key
 ingest file = do
 	backend <- chooseBackend file
+	ic <- withTSDelta (liftIO . genInodeCache file)
 	let source = KeySource
 		{ keyFilename = file
 		, contentLocation = file
-		, inodeCache = Nothing
+		, inodeCache = ic
 		}
 	k <- fst . fromMaybe (error "failed to generate a key")
 		<$> genKey source backend
 	-- Hard link (or copy) file content to annex object
 	-- to prevent it from being lost when git checks out
 	-- a branch not containing this file.
-	r <- linkAnnex k file
+	r <- linkAnnex k file ic
 	case r of
 		LinkAnnexFailed -> error "Problem adding file to the annex"
 		LinkAnnexOk -> logStatus k InfoPresent
diff --git a/Command/Unlock.hs b/Command/Unlock.hs
index 1cfd4a0b2..b82f78096 100644
--- a/Command/Unlock.hs
+++ b/Command/Unlock.hs
@@ -14,6 +14,8 @@ import Annex.CatFile
 import Annex.Version
 import Annex.Link
 import Annex.ReplaceFile
+import Annex.InodeSentinal
+import Utility.InodeCache
 import Utility.CopyFile
 
 cmd :: Command
@@ -51,8 +53,9 @@ start file key = ifM (isJust <$> isAnnexLink file)
 performNew :: FilePath -> Key -> CommandPerform
 performNew dest key = do
 	src <- calcRepo (gitAnnexLocation key)
+	srcic <- withTSDelta (liftIO . genInodeCache src)
 	replaceFile dest $ \tmp -> do
-		r <- linkAnnex' key src tmp
+		r <- linkAnnex' key src srcic tmp
 		case r of
 			LinkAnnexOk -> return ()
 			_ -> error "linkAnnex failed"
diff --git a/Upgrade/V5.hs b/Upgrade/V5.hs
index 2073a0150..f6d18df43 100644
--- a/Upgrade/V5.hs
+++ b/Upgrade/V5.hs
@@ -20,6 +20,7 @@ import qualified Git
 import qualified Git.LsFiles
 import qualified Git.Branch
 import Git.FileMode
+import Utility.InodeCache
 
 upgrade :: Bool -> Annex Bool
 upgrade automatic = do
@@ -88,7 +89,8 @@ upgradeDirectWorkTree = do
 		-- not populated with it. Since the work tree file
 		-- is recorded as an associated file, things will still
 		-- work that way, it's just not ideal.
-		void $ linkAnnex k f
+		ic <- withTSDelta (liftIO . genInodeCache f)
+		void $ linkAnnex k f ic
 	writepointer f k = liftIO $ do
 		nukeFile f
 		writeFile f (formatPointer k)