fix transferring to gcrypt repo from direct mode repo

recvkey was told it was receiving a HMAC key from a direct mode repo,
and that confused it into rejecting the transfer, since it has no way to
verify a key using that backend, since there is no HMAC backend.

I considered making recvkey skip verification in the case of an unknown
backend. However, that could lead to bad results; a key can legitimately be
in the annex with a backend that the remote git-annex-shell doesn't know
about. Better to keep it rejecting if it cannot verify.

Instead, made the gcrypt special remote not set the direct mode flag when
sending (and receiving) files.

Also, added some recvkey messages when its checks fail, since otherwise
all that is shown is a confusing error message from rsync when the remote
git-annex-shell exits nonzero.

4 files changed, 24 insertions, 13 deletions

diff --git a/Command/RecvKey.hs b/Command/RecvKey.hs
index eb2c88ca9..3b2a8c496 100644
--- a/Command/RecvKey.hs
+++ b/Command/RecvKey.hs
@@ -72,7 +72,18 @@ start key = ifM (inAnnex key)
 				return $ size == size'
 		if oksize
 			then case Backend.maybeLookupBackendName (Types.Key.keyBackendName key) of
-				Nothing -> return False
-				Just backend -> maybe (return True) (\a -> a key tmp)
+				Nothing -> do
+					warning "recvkey: received key from direct mode repository using unknown backend; cannot check; discarding"
+					return False
+				Just backend -> maybe (return True) runfsck
 					(Types.Backend.fsckKey backend)
-			else return False
+			else do
+				warning "recvkey: received key with wrong size; discarding"
+				return False
+	  where
+	  	runfsck check = ifM (check key tmp)
+			( return True
+			, do
+				warning "recvkey: received key from direct mode repository seems to have changed as it was transferred; discarding"
+				return False
+			)
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index b09943052..475a4785f 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -290,7 +290,7 @@ store r rsyncopts (cipher, enck) k p
 	storeshell = withTmp enck $ \tmp ->
 		ifM (spoolencrypted $ readBytes $ \b -> catchBoolIO $ L.writeFile tmp b >> return True)
 			( Ssh.rsyncHelper (Just p)
-				=<< Ssh.rsyncParamsRemote r Upload enck tmp Nothing
+				=<< Ssh.rsyncParamsRemote False r Upload enck tmp Nothing
 			, return False
 			)
 	spoolencrypted a = Annex.Content.sendAnnex k noop $ \src ->
@@ -312,7 +312,7 @@ retrieve r rsyncopts (cipher, enck) k d p
 				(readBytes $ meteredWriteFile meterupdate d)
 	retrieversync = Remote.Rsync.retrieveEncrypted rsyncopts (cipher, enck) k d p
 	retrieveshell = withTmp enck $ \tmp ->
-		ifM (Ssh.rsyncHelper (Just p) =<< Ssh.rsyncParamsRemote r Download enck tmp Nothing)
+		ifM (Ssh.rsyncHelper (Just p) =<< Ssh.rsyncParamsRemote False r Download enck tmp Nothing)
 			( liftIO $ catchBoolIO $ do
 				decrypt cipher (feedFile tmp) $
 					readBytes $ L.writeFile d
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 0f3f35811..e8ab57281 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -296,9 +296,10 @@ copyFromRemote' r key file dest
 					upload u key file noRetry
 						(rsyncOrCopyFile params object dest)
 						<&&> checksuccess
-	| Git.repoIsSsh (repo r) = feedprogressback $ \feeder -> 
+	| Git.repoIsSsh (repo r) = feedprogressback $ \feeder -> do
+		direct <- isDirect
 		Ssh.rsyncHelper (Just feeder) 
-			=<< Ssh.rsyncParamsRemote r Download key dest file
+			=<< Ssh.rsyncParamsRemote direct r Download key dest file
 	| Git.repoIsHttp (repo r) = Annex.Content.downloadUrl (keyUrls (repo r) key) dest
 	| otherwise = error "copying from non-ssh, non-http remote not supported"
   where
@@ -370,9 +371,10 @@ copyToRemote r key file p
 		guardUsable (repo r) False $ commitOnCleanup r $
 			copylocal =<< Annex.Content.prepSendAnnex key
 	| Git.repoIsSsh (repo r) = commitOnCleanup r $
-		Annex.Content.sendAnnex key noop $ \object ->
+		Annex.Content.sendAnnex key noop $ \object -> do
+			direct <- isDirect
 			Ssh.rsyncHelper (Just p)
-				=<< Ssh.rsyncParamsRemote r Upload key object file
+				=<< Ssh.rsyncParamsRemote direct r Upload key object file
 	| otherwise = error "copying to non-ssh repo not supported"
   where
 	copylocal Nothing = return False
diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs
index 82c7c3896..35655f00b 100644
--- a/Remote/Helper/Ssh.hs
+++ b/Remote/Helper/Ssh.hs
@@ -19,7 +19,6 @@ import Types.Key
 import Remote.Helper.Messages
 import Utility.Metered
 import Utility.Rsync
-import Config
 import Types.Remote
 import Logs.Transfer
 
@@ -111,10 +110,9 @@ rsyncHelper callback params = do
 
 {- Generates rsync parameters that ssh to the remote and asks it
  - to either receive or send the key's content. -}
-rsyncParamsRemote :: Remote -> Direction -> Key -> FilePath -> AssociatedFile -> Annex [CommandParam]
-rsyncParamsRemote r direction key file afile = do
+rsyncParamsRemote :: Bool -> Remote -> Direction -> Key -> FilePath -> AssociatedFile -> Annex [CommandParam]
+rsyncParamsRemote direct r direction key file afile = do
 	u <- getUUID
-	direct <- isDirect
 	let fields = (Fields.remoteUUID, fromUUID u)
 		: (Fields.direct, if direct then "1" else "")
 		: maybe [] (\f -> [(Fields.associatedFile, f)]) afile