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.

6 files changed, 51 insertions, 28 deletions

diff --git a/Annex/Direct.hs b/Annex/Direct.hs
index 55bff785c..733cb9356 100644
--- a/Annex/Direct.hs
+++ b/Annex/Direct.hs
@@ -79,6 +79,7 @@ addDirect file cache = do
 	let source = KeySource
 		{ keyFilename = file
 		, contentLocation = file
+		, inodeCache = Just cache
 		}
 	got =<< genKey source =<< chooseBackend file
   where
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
diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs
index 9197d6844..41a947db8 100644
--- a/Command/AddUrl.hs
+++ b/Command/AddUrl.hs
@@ -75,7 +75,11 @@ download url file = do
 	liftIO $ createDirectoryIfMissing True (parentDir tmp)
 	stopUnless (downloadUrl [url] tmp) $ do
 		backend <- chooseBackend file
-		let source = KeySource { keyFilename = file, contentLocation = tmp }
+		let source = KeySource
+			{ keyFilename = file
+			, contentLocation = tmp
+			, inodeCache = Nothing
+			}
 		k <- genKey source backend
 		case k of
 			Nothing -> stop
diff --git a/Command/Migrate.hs b/Command/Migrate.hs
index f3ff0dd72..5374bc928 100644
--- a/Command/Migrate.hs
+++ b/Command/Migrate.hs
@@ -63,5 +63,9 @@ perform file oldkey oldbackend newbackend = do
 		next $ Command.ReKey.cleanup file oldkey newkey
 	genkey = do
 		content <- inRepo $ gitAnnexLocation oldkey
-		let source = KeySource { keyFilename = file, contentLocation = content }
+		let source = KeySource
+			{ keyFilename = file
+			, contentLocation = content
+			, inodeCache = Nothing
+			}
 		liftM fst <$> genKey source (Just newbackend)
diff --git a/Types/KeySource.hs b/Types/KeySource.hs
index 628954c33..fd4af07a6 100644
--- a/Types/KeySource.hs
+++ b/Types/KeySource.hs
@@ -7,6 +7,8 @@
 
 module Types.KeySource where
 
+import Utility.InodeCache
+
 {- When content is in the process of being added to the annex,
  - and a Key generated from it, this data type is used. 
  -
@@ -16,10 +18,12 @@ module Types.KeySource where
  - for checking. The migrate command uses the content
  - of a different Key.
  -
- - 
+ - The inodeCache can be used to detect some types of modifications to
+ - files that may be made while they're in the process of being added.
  -}
 data KeySource = KeySource
 	{ keyFilename :: FilePath
 	, contentLocation :: FilePath
+	, inodeCache :: Maybe InodeCache
 	}
 	deriving (Show)
diff --git a/debian/changelog b/debian/changelog
index 0359dc5c0..ef01e4bf3 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -8,6 +8,7 @@ git-annex (3.20130208) UNRELEASED; urgency=low
     support hard links, or symlinks, or unix permissions, and set
     annex.crippledfilesystem, as well as annex.direct. This allows
     use of git-annex repositories on FAT and even worse filesystems.
+  * add: Improved detection of files that are modified while being added.
 
  -- Joey Hess <joeyh@debian.org>  Sun, 10 Feb 2013 14:52:01 -0400