plumb RemoteGitConfig through to decryptCipher

Remote/Bup.hs

@@ -91,13 +91,13 @@ gen r u c gc = do
 		}
 
 bupSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-bupSetup mu _ c _ = do
+bupSetup mu _ c gc = do
 	u <- maybe (liftIO genUUID) return mu
 
 	-- verify configuration is sane
 	let buprepo = fromMaybe (error "Specify buprepo=") $
 		M.lookup "buprepo" c
-	(c', _encsetup) <- encryptionSetup c
+	(c', _encsetup) <- encryptionSetup c gc
 
 	-- bup init will create the repository.
 	-- (If the repository already exists, bup init again appears safe.)

Remote/Ddar.hs

@@ -83,13 +83,13 @@ gen r u c gc = do
 		}
 
 ddarSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-ddarSetup mu _ c _ = do
+ddarSetup mu _ c gc = do
 	u <- maybe (liftIO genUUID) return mu
 
 	-- verify configuration is sane
 	let ddarrepo = fromMaybe (error "Specify ddarrepo=") $
 		M.lookup "ddarrepo" c
-	(c', _encsetup) <- encryptionSetup c
+	(c', _encsetup) <- encryptionSetup c gc
 
 	-- The ddarrepo is stored in git config, as well as this repo's
 	-- persistant state, so it can vary between hosts.

Remote/Directory.hs

@@ -78,7 +78,7 @@ gen r u c gc = do
 	dir = fromMaybe (error "missing directory") $ remoteAnnexDirectory gc
 
 directorySetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-directorySetup mu _ c _ = do
+directorySetup mu _ c gc = do
 	u <- maybe (liftIO genUUID) return mu
 	-- verify configuration is sane
 	let dir = fromMaybe (error "Specify directory=") $
@@ -86,7 +86,7 @@ directorySetup mu _ c _ = do
 	absdir <- liftIO $ absPath dir
 	liftIO $ unlessM (doesDirectoryExist absdir) $
 		error $ "Directory does not exist: " ++ absdir
-	(c', _encsetup) <- encryptionSetup c
+	(c', _encsetup) <- encryptionSetup c gc
 
 	-- The directory is stored in git config, not in this remote's
 	-- persistant state, so it can vary between hosts.

Remote/External.hs

@@ -113,7 +113,7 @@ externalSetup mu _ c gc = do
 	u <- maybe (liftIO genUUID) return mu
 	let externaltype = fromMaybe (error "Specify externaltype=") $
 		M.lookup "externaltype" c
-	(c', _encsetup) <- encryptionSetup c
+	(c', _encsetup) <- encryptionSetup c gc
 
 	c'' <- case M.lookup "readonly" c of
 		Just v | isTrue v == Just True -> do

Remote/GCrypt.hs

@@ -170,12 +170,12 @@ unsupportedUrl :: a
 unsupportedUrl = error "using non-ssh remote repo url with gcrypt is not supported"
 
 gCryptSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-gCryptSetup mu _ c _ = go $ M.lookup "gitrepo" c
+gCryptSetup mu _ c gc = go $ M.lookup "gitrepo" c
   where
 	remotename = fromJust (M.lookup "name" c)
 	go Nothing = error "Specify gitrepo="
 	go (Just gitrepo) = do
-		(c', _encsetup) <- encryptionSetup c
+		(c', _encsetup) <- encryptionSetup c gc
 		inRepo $ Git.Command.run 
 			[ Param "remote", Param "add"
 			, Param remotename

Remote/Glacier.hs

@@ -84,7 +84,7 @@ glacierSetup mu mcreds c gc = do
 	glacierSetup' (isJust mu) u mcreds c gc
 glacierSetup' :: Bool -> UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
 glacierSetup' enabling u mcreds c gc = do
-	(c', encsetup) <- encryptionSetup c
+	(c', encsetup) <- encryptionSetup c gc
 	c'' <- setRemoteCredPair encsetup c' gc (AWS.creds u) mcreds
 	let fullconfig = c'' `M.union` defaults
 	unless enabling $
@@ -288,7 +288,7 @@ jobList r keys = go =<< glacierEnv (config r) (gitconfig r) (uuid r)
 			else do
 				enckeys <- forM keys $ \k ->
 					maybe k (\(_, enck) -> enck k)
-						<$> cipherKey (config r)
+						<$> cipherKey (config r) (gitconfig r)
 				let keymap = M.fromList $ zip enckeys keys
 				let convert = mapMaybe (`M.lookup` keymap)
 				return (convert succeeded, convert failed)

Remote/Helper/Encryptable.hs

@@ -48,8 +48,8 @@ encryptionAlreadySetup = EncryptionIsSetup
  - an encryption key, or not encrypt. An encrypted cipher is created, or is
  - updated to be accessible to an additional encryption key. Or the user
  - could opt to use a shared cipher, which is stored unencrypted. -}
-encryptionSetup :: RemoteConfig -> Annex (RemoteConfig, EncryptionIsSetup)
-encryptionSetup c = do
+encryptionSetup :: RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, EncryptionIsSetup)
+encryptionSetup c gc = do
 	cmd <- gpgCmd <$> Annex.getGitConfig
 	maybe (genCipher cmd) (updateCipher cmd) (extractCipher c)
   where
@@ -78,10 +78,10 @@ encryptionSetup c = do
 	updateCipher cmd v = case v of
 		SharedCipher _ | maybe True (== "shared") encryption -> return (c', EncryptionIsSetup)
 		EncryptedCipher _ variant _
-			| maybe True (== if variant == Hybrid then "hybrid" else "pubkey") encryption ->
-				use "encryption update" $ updateCipherKeyIds cmd newkeys v
+			| maybe True (== if variant == Hybrid then "hybrid" else "pubkey") encryption -> do
+				use "encryption update" $ updateCipherKeyIds cmd (c, gc) newkeys v
 		SharedPubKeyCipher _ _ ->
-			use "encryption update" $ updateCipherKeyIds cmd newkeys v
+			use "encryption update" $ updateCipherKeyIds cmd (c, gc) newkeys v
 		_ -> cannotchange
 	encsetup a = use "encryption setup" . a =<< highRandomQuality
 	use m a = do
@@ -99,13 +99,13 @@ encryptionSetup c = do
 		-- remotes (while being backward-compatible).
 		[ "keyid", "keyid+", "keyid-", "highRandomQuality" ]
 
-remoteCipher :: RemoteConfig -> Annex (Maybe Cipher)
-remoteCipher = fmap fst <$$> remoteCipher'
+remoteCipher :: RemoteConfig -> RemoteGitConfig -> Annex (Maybe Cipher)
+remoteCipher c gc = fmap fst <$> remoteCipher' c gc
 
 {- Gets encryption Cipher. The decrypted Ciphers are cached in the Annex
  - state. -}
-remoteCipher' :: RemoteConfig -> Annex (Maybe (Cipher, StorableCipher))
-remoteCipher' c = go $ extractCipher c
+remoteCipher' :: RemoteConfig -> RemoteGitConfig -> Annex (Maybe (Cipher, StorableCipher))
+remoteCipher' c gc = go $ extractCipher c
   where
 	go Nothing = return Nothing
 	go (Just encipher) = do
@@ -114,7 +114,7 @@ remoteCipher' c = go $ extractCipher c
 			Just cipher -> return $ Just (cipher, encipher)
 			Nothing -> do
 				cmd <- gpgCmd <$> Annex.getGitConfig
-				cipher <- liftIO $ decryptCipher cmd encipher
+				cipher <- liftIO $ decryptCipher cmd (c, gc) encipher
 				Annex.changeState (\s -> s { Annex.ciphers = M.insert encipher cipher cache })
 				return $ Just (cipher, encipher)
 
@@ -134,8 +134,8 @@ embedCreds c
 	| otherwise = False
 
 {- Gets encryption Cipher, and key encryptor. -}
-cipherKey :: RemoteConfig -> Annex (Maybe (Cipher, EncKey))
-cipherKey c = fmap make <$> remoteCipher c
+cipherKey :: RemoteConfig -> RemoteGitConfig -> Annex (Maybe (Cipher, EncKey))
+cipherKey c gc = fmap make <$> remoteCipher c gc
   where
 	make ciphertext = (ciphertext, encryptKey mac ciphertext)
 	mac = fromMaybe defaultMac $ M.lookup "mac" c >>= readMac

Remote/Helper/Special.hs

@@ -176,7 +176,7 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
 			then whereisKey baser
 			else Nothing
 		}
-	cip = cipherKey c
+	cip = cipherKey c (gitconfig baser)
 	isencrypted = isJust (extractCipher c)
 
 	safely a = catchNonAsync a (\e -> warning (show e) >> return False)

Remote/Hook.hs

@@ -71,11 +71,11 @@ gen r u c gc = do
 	hooktype = fromMaybe (error "missing hooktype") $ remoteAnnexHookType gc
 
 hookSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-hookSetup mu _ c _ = do
+hookSetup mu _ c gc = do
 	u <- maybe (liftIO genUUID) return mu
 	let hooktype = fromMaybe (error "Specify hooktype=") $
 		M.lookup "hooktype" c
-	(c', _encsetup) <- encryptionSetup c
+	(c', _encsetup) <- encryptionSetup c gc
 	gitConfigSpecialRemote u c' "hooktype" hooktype
 	return (c', u)
 

Remote/Rsync.hs

@@ -138,12 +138,12 @@ rsyncTransport gc url
 	fromNull as xs = if null xs then as else xs
 
 rsyncSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-rsyncSetup mu _ c _ = do
+rsyncSetup mu _ c gc = do
 	u <- maybe (liftIO genUUID) return mu
 	-- verify configuration is sane
 	let url = fromMaybe (error "Specify rsyncurl=") $
 		M.lookup "rsyncurl" c
-	(c', _encsetup) <- encryptionSetup c
+	(c', _encsetup) <- encryptionSetup c gc
 
 	-- The rsyncurl is stored in git config, not only in this remote's
 	-- persistant state, so it can vary between hosts.

Remote/S3.hs

@@ -123,7 +123,7 @@ s3Setup' new u mcreds c gc
 		return (fullconfig, u)
 
 	defaulthost = do
-		(c', encsetup) <- encryptionSetup c
+		(c', encsetup) <- encryptionSetup c gc
 		c'' <- setRemoteCredPair encsetup c' gc (AWS.creds u) mcreds
 		let fullconfig = c'' `M.union` defaults
 		when new $

Remote/WebDAV.hs

@@ -87,7 +87,7 @@ webdavSetup mu mcreds c gc = do
 	url <- case M.lookup "url" c of
 		Nothing -> error "Specify url="
 		Just url -> return url
-	(c', encsetup) <- encryptionSetup c
+	(c', encsetup) <- encryptionSetup c gc
 	creds <- maybe (getCreds c' gc u) (return . Just) mcreds
 	testDav url creds
 	gitConfigSpecialRemote u c' "webdav" "true"