Do verification of checksums of annex objects downloaded from remotes.

* When annex objects are received into git repositories, their checksums are
  verified then too.
* To get the old, faster, behavior of not verifying checksums, set
  annex.verify=false, or remote.<name>.annex-verify=false.
* setkey, rekey: These commands also now verify that the provided file
  matches the key, unless annex.verify=false.
* reinject: Already verified content; this can now be disabled by
  setting annex.verify=false.

recvkey and reinject already did verification, so removed now duplicate
code from them. fsck still does its own verification, which is ok since it
does not use getViaTmp, so verification doesn't happen twice when using fsck
--from.

1 files changed, 53 insertions, 10 deletions

diff --git a/Annex/Content.hs b/Annex/Content.hs
index 32c164417..679b7e6b7 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -16,6 +16,7 @@ module Annex.Content (
 	getViaTmp,
 	getViaTmp',
 	checkDiskSpaceToGet,
+	Verify(..),
 	prepTmp,
 	withTmp,
 	checkDiskSpace,
@@ -61,6 +62,9 @@ import Annex.Content.Direct
 import Annex.ReplaceFile
 import Utility.LockPool
 import Messages.Progress
+import qualified Types.Remote
+import qualified Types.Backend
+import qualified Backend
 
 {- Checks if a given key's content is currently present. -}
 inAnnex :: Key -> Annex Bool
@@ -214,25 +218,64 @@ lockContent key a = do
 {- Runs an action, passing it the temp file to get,
  - and if the action succeeds, verifies the file matches
  - the key and moves the file into the annex as a key's content. -}
-getViaTmp :: Key -> (FilePath -> Annex Bool) -> Annex Bool
-getViaTmp key action = checkDiskSpaceToGet key False $ getViaTmp' key action
+getViaTmp :: Verify -> Key -> (FilePath -> Annex Bool) -> Annex Bool
+getViaTmp v key action = checkDiskSpaceToGet key False $
+	getViaTmp' v key action
 
 {- Like getViaTmp, but does not check that there is enough disk space
  - for the incoming key. For use when the key content is already on disk
  - and not being copied into place. -}
-getViaTmp' :: Key -> (FilePath -> Annex Bool) -> Annex Bool
-getViaTmp' key action = do
+getViaTmp' :: Verify -> Key -> (FilePath -> Annex Bool) -> Annex Bool
+getViaTmp' v key action = do
 	tmpfile <- prepTmp key
 	ifM (action tmpfile)
-		( do
-			moveAnnex key tmpfile
-			logStatus key InfoPresent
-			return True
-		-- the tmp file is left behind, in case caller wants
-		-- to resume its transfer
+		( ifM (verifyKeyContent v key tmpfile)
+			( do
+				moveAnnex key tmpfile
+				logStatus key InfoPresent
+				return True
+			, do
+				warning "verification of content failed"
+				liftIO $ nukeFile tmpfile
+				return False
+			)
+		-- On transfer failure, the tmp file is left behind, in case
+		-- caller wants to resume its transfer
 		, return False
 		)
 
+{- Verifies that a file is the expected content of a key.
+ -
+ - Most keys have a known size, and if so, the file size is checked.
+ - This is not expensive, so is always done.
+ -
+ - When the key's backend allows verifying the content (eg via checksum),
+ - it is checked. This is an expensive check, so configuration can prevent
+ - it, for either a particular remote or always.
+ -}
+verifyKeyContent :: Verify -> Key -> FilePath -> Annex Bool
+verifyKeyContent v k f = verifysize <&&> verifycontent
+  where
+	verifysize = case Types.Key.keySize k of
+		Nothing -> return True
+		Just size -> do
+			size' <- liftIO $ catchDefaultIO 0 $ getFileSize f
+			return (size' == size)
+	verifycontent = ifM (shouldVerify v)
+		( case Types.Backend.verifyKeyContent =<< Backend.maybeLookupBackendName (Types.Key.keyBackendName k) of
+			Nothing -> return True
+			Just verifier -> verifier k f
+		, return True
+		)
+
+data Verify = AlwaysVerify | RemoteVerify Remote | DefaultVerify
+
+shouldVerify :: Verify -> Annex Bool
+shouldVerify AlwaysVerify = return True
+shouldVerify DefaultVerify = annexVerify <$> Annex.getGitConfig
+shouldVerify (RemoteVerify r) = shouldVerify DefaultVerify
+	<&&> pure (remoteAnnexVerify (Types.Remote.gitconfig r))
+
 {- Checks if there is enough free disk space to download a key
  - to its temp file.
  -