add retrievalSecurityPolicy

This will be used to protect against CVE-2018-10859, where an encrypted
special remote is fed the wrong encrypted data, and so tricked into
decrypting something that the user encrypted with their gpg key and did
not store in git-annex.

It also protects against CVE-2018-10857, where a remote follows a http
redirect to a file:// url or to a local private web server. While that's
already been prevented in git-annex's own use of http, external special
remotes, hooks, etc use other http implementations and could still be
vulnerable.

The policy is not yet enforced, this commit only adds the appropriate
metadata to remotes.

This commit was sponsored by Boyd Stephen Smith Jr. on Patreon.

Remote/Adb.hs

@@ -48,6 +48,7 @@ gen r u c gc = do
 		, storeKey = storeKeyDummy
 		, retrieveKeyFile = retreiveKeyFileDummy
 		, retrieveKeyFileCheap = \_ _ _ -> return False
+		, retrievalSecurityPolicy = RetrievalAllKeysSecure
 		, removeKey = removeKeyDummy
 		, lockContent = Nothing
 		, checkPresent = checkPresentDummy

Remote/BitTorrent.hs

@@ -59,6 +59,8 @@ gen r _ c gc =
 		, storeKey = uploadKey
 		, retrieveKeyFile = downloadKey
 		, retrieveKeyFileCheap = downloadKeyCheap
+		-- Bittorrent does its own hash checks.
+		, retrievalSecurityPolicy = RetrievalAllKeysSecure
 		, removeKey = dropKey
 		, lockContent = Nothing
 		, checkPresent = checkKey

Remote/Bup.hs

@@ -59,6 +59,9 @@ gen r u c gc = do
 		, storeKey = storeKeyDummy
 		, retrieveKeyFile = retreiveKeyFileDummy
 		, retrieveKeyFileCheap = retrieveCheap buprepo
+		-- Bup uses git, which cryptographically verifies content
+		-- (with SHA1, but sufficiently for this).
+		, retrievalSecurityPolicy = RetrievalAllKeysSecure
 		, removeKey = removeKeyDummy
 		, lockContent = Nothing
 		, checkPresent = checkPresentDummy

Remote/Ddar.hs

@@ -58,6 +58,8 @@ gen r u c gc = do
 		, storeKey = storeKeyDummy
 		, retrieveKeyFile = retreiveKeyFileDummy
 		, retrieveKeyFileCheap = retrieveCheap
+		-- Unsure about this, safe default until Robie answers.
+		, retrievalSecurityPolicy = RetrievalVerifiableKeysSecure
 		, removeKey = removeKeyDummy
 		, lockContent = Nothing
 		, checkPresent = checkPresentDummy

Remote/Directory.hs

@@ -58,6 +58,7 @@ gen r u c gc = do
 			, storeKey = storeKeyDummy
 			, retrieveKeyFile = retreiveKeyFileDummy
 			, retrieveKeyFileCheap = retrieveKeyFileCheapM dir chunkconfig
+			, retrievalSecurityPolicy = RetrievalAllKeysSecure
 			, removeKey = removeKeyDummy
 			, lockContent = Nothing
 			, checkPresent = checkPresentDummy

Remote/External.hs

@@ -109,6 +109,11 @@ gen r u c gc
 			, storeKey = storeKeyDummy
 			, retrieveKeyFile = retreiveKeyFileDummy
 			, retrieveKeyFileCheap = \_ _ _ -> return False
+			-- External special remotes use many http libraries
+			-- and have no protection against redirects to
+			-- local private web servers, or in some cases
+			-- to file:// urls.
+			, retrievalSecurityPolicy = RetrievalVerifiableKeysSecure
 			, removeKey = removeKeyDummy
 			, lockContent = Nothing
 			, checkPresent = checkPresentDummy

Remote/GCrypt.hs

@@ -113,6 +113,7 @@ gen' r u c gc = do
 		, storeKey = storeKeyDummy
 		, retrieveKeyFile = retreiveKeyFileDummy
 		, retrieveKeyFileCheap = \_ _ _ -> return False
+		, retrievalSecurityPolicy = RetrievalAllKeysSecure
 		, removeKey = removeKeyDummy
 		, lockContent = Nothing
 		, checkPresent = checkPresentDummy

Remote/Git.hs

@@ -161,6 +161,7 @@ gen r u c gc
 			, storeKey = copyToRemote new st
 			, retrieveKeyFile = copyFromRemote new st
 			, retrieveKeyFileCheap = copyFromRemoteCheap new st
+			, retrievalSecurityPolicy = RetrievalAllKeysSecure
 			, removeKey = dropKey new st
 			, lockContent = Just (lockKey new st)
 			, checkPresent = inAnnex new st

Remote/Glacier.hs

@@ -55,6 +55,9 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost
 			, storeKey = storeKeyDummy
 			, retrieveKeyFile = retreiveKeyFileDummy
 			, retrieveKeyFileCheap = retrieveCheap this
+			-- glacier-cli does not follow redirects and does
+			-- not support file://, so this is secure.
+			, retrievalSecurityPolicy = RetrievalAllKeysSecure
 			, removeKey = removeKeyDummy
 			, lockContent = Nothing
 			, checkPresent = checkPresentDummy

Remote/Helper/Special.hs

@@ -162,6 +162,14 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
 			(retrieveKeyFileCheap baser k f d)
 			-- retrieval of encrypted keys is never cheap
 			(\_ -> return False)
+		-- When encryption is used, the remote could provide
+		-- some other content encrypted by the user, and trick
+		-- git-annex into decrypting it, leaking the decryption
+		-- into the git-annex repository. Verifiable keys
+		-- are the main protection against this attack.
+		, retrievalSecurityPolicy = if isencrypted
+			then RetrievalVerifiableKeysSecure
+			else retrievalSecurityPolicy baser
 		, removeKey = \k -> cip >>= removeKeyGen k
 		, checkPresent = \k -> cip >>= checkPresentGen k
 		, cost = if isencrypted

Remote/Hook.hs

@@ -49,6 +49,9 @@ gen r u c gc = do
 			, storeKey = storeKeyDummy
 			, retrieveKeyFile = retreiveKeyFileDummy
 			, retrieveKeyFileCheap = retrieveCheap hooktype
+			-- A hook could use http and be vulnerable to
+			-- redirect to file:// attacks, etc.
+			, retrievalSecurityPolicy = RetrievalVerifiableKeysSecure
 			, removeKey = removeKeyDummy
 			, lockContent = Nothing
 			, checkPresent = checkPresentDummy

Remote/P2P.hs

@@ -53,6 +53,7 @@ chainGen addr r u c gc = do
 		, storeKey = store (const protorunner)
 		, retrieveKeyFile = retrieve (const protorunner)
 		, retrieveKeyFileCheap = \_ _ _ -> return False
+		, retrievalSecurityPolicy = RetrievalAllKeysSecure
 		, removeKey = remove protorunner
 		, lockContent = Just $ lock withconn runProtoConn u 
 		, checkPresent = checkpresent protorunner

Remote/Rsync.hs

@@ -72,6 +72,7 @@ gen r u c gc = do
 			, storeKey = storeKeyDummy
 			, retrieveKeyFile = retreiveKeyFileDummy
 			, retrieveKeyFileCheap = retrieveCheap o
+			, retrievalSecurityPolicy = RetrievalAllKeysSecure
 			, removeKey = removeKeyDummy
 			, lockContent = Nothing
 			, checkPresent = checkPresentDummy

Remote/S3.hs

@@ -84,6 +84,9 @@ gen r u c gc = do
 			, storeKey = storeKeyDummy
 			, retrieveKeyFile = retreiveKeyFileDummy
 			, retrieveKeyFileCheap = retrieveCheap
+			-- HttpManagerRestricted is used here, so this is
+			-- secure.
+			, retrievalSecurityPolicy = RetrievalAllKeysSecure
 			, removeKey = removeKeyDummy
 			, lockContent = Nothing
 			, checkPresent = checkPresentDummy

Remote/Tahoe.hs

@@ -73,6 +73,8 @@ gen r u c gc = do
 		, storeKey = store u hdl
 		, retrieveKeyFile = retrieve u hdl
 		, retrieveKeyFileCheap = \_ _ _ -> return False
+		-- Tahoe cryptographically verifies content.
+		, retrievalSecurityPolicy = RetrievalAllKeysSecure
 		, removeKey = remove
 		, lockContent = Nothing
 		, checkPresent = checkKey u hdl

Remote/Web.hs

@@ -48,6 +48,9 @@ gen r _ c gc =
 		, storeKey = uploadKey
 		, retrieveKeyFile = downloadKey
 		, retrieveKeyFileCheap = downloadKeyCheap
+		-- HttpManagerRestricted is used here, so this is
+		-- secure.
+		, retrievalSecurityPolicy = RetrievalAllKeysSecure
 		, removeKey = dropKey
 		, lockContent = Nothing
 		, checkPresent = checkKey

Remote/WebDAV.hs

@@ -72,6 +72,9 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
 			, storeKey = storeKeyDummy
 			, retrieveKeyFile = retreiveKeyFileDummy
 			, retrieveKeyFileCheap = retrieveCheap
+			-- HttpManagerRestricted is used here, so this is
+			-- secure.
+			, retrievalSecurityPolicy = RetrievalAllKeysSecure
 			, removeKey = removeKeyDummy
 			, lockContent = Nothing
 			, checkPresent = checkPresentDummy

Types/Key.hs

@@ -1,6 +1,6 @@
 {- git-annex Key data type
  -
- - Copyright 2011-2017 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2018 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -88,6 +88,23 @@ cryptographicallySecure (Blake2sKey _ _) = True
 cryptographicallySecure (Blake2spKey _ _) = True
 cryptographicallySecure _ = False
 
+{- Is the Key variety backed by a hash, which allows verifying content?
+ - It does not have to be cryptographically secure against eg birthday
+ - attacks.
+ -}
+isVerifiable :: KeyVariety -> Bool
+isVerifiable (SHA2Key _ _) = True
+isVerifiable (SHA3Key _ _) = True
+isVerifiable (SKEINKey _ _) = True
+isVerifiable (Blake2bKey _ _) = True
+isVerifiable (Blake2sKey _ _) = True
+isVerifiable (Blake2spKey _ _) = True
+isVerifiable (SHA1Key _) = True
+isVerifiable (MD5Key _) = True
+isVerifiable WORMKey = False
+isVerifiable URLKey = False
+isVerifiable (OtherKey _) =  False
+
 formatKeyVariety :: KeyVariety -> String
 formatKeyVariety v = case v of
 	SHA2Key sz e -> adde e (addsz sz "SHA")

Types/Remote.hs

@@ -2,7 +2,7 @@
  -
  - Most things should not need this, using Types instead
  -
- - Copyright 2011-2017 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2018 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -18,6 +18,7 @@ module Types.Remote
 	, Availability(..)
 	, Verification(..)
 	, unVerified
+	, RetrievalSecurityPolicy(..)
 	, isExportSupported
 	, ExportActions(..)
 	)
@@ -85,6 +86,8 @@ data RemoteA a = Remote
 	-- Retrieves a key's contents to a tmp file, if it can be done cheaply.
 	-- It's ok to create a symlink or hardlink.
 	, retrieveKeyFileCheap :: Key -> AssociatedFile -> FilePath -> a Bool
+	-- Security policy for reteiving keys from this remote.
+	, retrievalSecurityPolicy :: RetrievalSecurityPolicy
 	-- Removes a key's contents (succeeds if the contents are not present)
 	, removeKey :: Key -> a Bool
 	-- Uses locking to prevent removal of a key's contents,
@@ -165,6 +168,32 @@ unVerified a = do
 	ok <- a
 	return (ok, UnVerified)
 
+-- Security policy indicating what keys can be safely retrieved from a
+-- remote.
+data RetrievalSecurityPolicy
+	= RetrievalVerifiableKeysSecure
+	-- ^ Transfer of keys whose content can be verified
+	-- with a hash check is secure; transfer of unverifiable keys is
+	-- not secure and should not be allowed.
+	--
+	-- This is used eg, when HTTP to a remote could be redirected to a
+	-- local private web server or even a file:// url, causing private
+	-- data from it that is not the intended content of a key to make
+	-- its way into the git-annex repository.
+	--
+	-- It's also used when content is stored encrypted on a remote,
+	-- which could replace it with a different encrypted file, and
+	-- trick git-annex into decrypting it and leaking the decryption
+	-- into the git-annex repository.
+	--
+	-- It's not (currently) used when the remote could alter the
+	-- content stored on it, because git-annex does not provide
+	-- strong guarantees about the content of keys that cannot be 
+	-- verified with a hash check.
+	-- (But annex.securehashesonly does provide such guarantees.)
+	| RetrievalAllKeysSecure
+	-- ^ Any key can be securely retrieved.
+
 isExportSupported :: RemoteA a -> a Bool
 isExportSupported r = exportSupported (remotetype r) (config r) (gitconfig r)