From 99ea159fce3fb98080b5e39770fc22b79d58d50f Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 14 Feb 2013 16:54:36 -0400
Subject: 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.
---
 Command/Add.hs     | 59 +++++++++++++++++++++++++++++++-----------------------
 Command/AddUrl.hs  |  6 +++++-
 Command/Migrate.hs |  6 +++++-
 3 files changed, 44 insertions(+), 27 deletions(-)

(limited to 'Command')

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)
-- 
cgit v1.2.3