Pass the various gnupg-options configs to gpg in several cases where they were not before.

Removed the instance LensGpgEncParams RemoteConfig because it encouraged
code that does not take the RemoteGitConfig into account.

RemoteType's setup was changed to take a RemoteGitConfig,
although the only place that is able to provide a non-empty one is
enableremote, when it's changing an existing remote. This led to several
folow-on changes, and got RemoteGitConfig plumbed through.

Annex/SpecialRemote.hs

@@ -80,7 +80,7 @@ autoEnable = do
 		case (M.lookup nameKey c, findType c) of
 			(Just name, Right t) -> whenM (canenable u) $ do
 				showSideAction $ "Auto enabling special remote " ++ name
-				res <- tryNonAsync $ setup t (Just u) Nothing c
+				res <- tryNonAsync $ setup t (Just u) Nothing c def
 				case res of
 					Left e -> warning (show e)
 					Right _ -> return ()

Assistant/MakeRemote.hs

@@ -101,8 +101,8 @@ setupSpecialRemote' setdesc name remotetype config mcreds (mu, c) = do
 	 - assistant, because otherwise GnuPG may block once the entropy
 	 - pool is drained, and as of now there's no way to tell the user
 	 - to perform IO actions to refill the pool. -}
-	(c', u) <- R.setup remotetype mu mcreds $
+	let weakc = M.insert "highRandomQuality" "false" $ M.union config c
-		M.insert "highRandomQuality" "false" $ M.union config c
+	(c', u) <- R.setup remotetype mu mcreds weakc def
 	configSet u c'
 	when setdesc $
 		whenM (isNothing . M.lookup u <$> uuidMap) $
@@ -168,4 +168,4 @@ previouslyUsedCredPair getstorage remotetype criteria =
 	sametype r = R.typename (R.remotetype r) == R.typename remotetype
 	fromstorage r = do
 		let storage = getstorage (R.uuid r)
-		getRemoteCredPair (R.config r) storage
+		getRemoteCredPair (R.config r) (R.gitconfig r) storage

Assistant/WebApp/Configurators/WebDAV.hs

@@ -95,7 +95,7 @@ postEnableWebDAVR uuid = do
 	let name = fromJust $ M.lookup "name" c
 	let url = fromJust $ M.lookup "url" c
 	mcreds <- liftAnnex $
-		getRemoteCredPairFor "webdav" c (WebDAV.davCreds uuid)
+		getRemoteCredPairFor "webdav" c def (WebDAV.davCreds uuid)
 	case mcreds of
 		Just creds -> webDAVConfigurator $ liftH $
 			makeWebDavRemote enableSpecialRemote name creds M.empty

Command/EnableRemote.hs

@@ -12,6 +12,7 @@ import qualified Logs.Remote
 import qualified Types.Remote as R
 import qualified Annex.SpecialRemote
 import qualified Remote
+import qualified Types.Remote as Remote
 import Logs.UUID
 
 import qualified Data.Map as M
@@ -43,7 +44,8 @@ start (name:ws) = go =<< Annex.SpecialRemote.findExisting name
 		let fullconfig = config `M.union` c	
 		t <- either error return (Annex.SpecialRemote.findType fullconfig)
 		showStart "enableremote" name
-		next $ perform t u fullconfig
+		gc <- maybe def Remote.gitconfig <$> Remote.byUUID u
+		next $ perform t u fullconfig gc
 
 unknownNameError :: String -> Annex a
 unknownNameError prefix = do
@@ -56,9 +58,9 @@ unknownNameError prefix = do
 				descm (M.keys m)
 	error $ prefix ++ "\n" ++ msg
 
-perform :: RemoteType -> UUID -> R.RemoteConfig -> CommandPerform
+perform :: RemoteType -> UUID -> R.RemoteConfig -> RemoteGitConfig -> CommandPerform
-perform t u c = do
+perform t u c gc = do
-	(c', u') <- R.setup t (Just u) Nothing c
+	(c', u') <- R.setup t (Just u) Nothing c gc
 	next $ cleanup u' c'
 
 cleanup :: UUID -> R.RemoteConfig -> CommandCleanup

Command/InitRemote.hs

@@ -46,7 +46,7 @@ start (name:ws) = ifM (isJust <$> findExisting name)
 
 perform :: RemoteType -> String -> R.RemoteConfig -> CommandPerform
 perform t name c = do
-	(c', u) <- R.setup t Nothing Nothing c
+	(c', u) <- R.setup t Nothing Nothing c def
 	next $ cleanup u name c'
 
 cleanup :: UUID -> String -> R.RemoteConfig -> CommandCleanup

Creds.hs

@@ -52,33 +52,37 @@ data CredPairStorage = CredPairStorage
  - cipher. The EncryptionIsSetup phantom type ensures that is the case.
  -}
 setRemoteCredPair :: EncryptionIsSetup -> RemoteConfig -> CredPairStorage -> Maybe CredPair -> Annex RemoteConfig
-setRemoteCredPair encsetup c storage Nothing = 
+setRemoteCredPair encsetup c storage mcreds = case mcreds of
-	maybe (return c) (setRemoteCredPair encsetup c storage . Just)
+	Nothing -> maybe (return c) (setRemoteCredPair encsetup c storage . Just)
-		=<< getRemoteCredPair c storage
+		=<< getRemoteCredPair c nogitconfig storage
-setRemoteCredPair _ c storage (Just creds)
+	Just creds
-	| embedCreds c = case credPairRemoteKey storage of
+		| embedCreds c -> case credPairRemoteKey storage of
-		Nothing -> localcache
+			Nothing -> localcache creds
-		Just key -> storeconfig key =<< remoteCipher =<< localcache
+			Just key -> storeconfig creds key =<< remoteCipher =<< localcache creds
-	| otherwise = localcache
+		| otherwise -> localcache creds
   where
-	localcache = do
+	localcache creds = do
 		writeCacheCredPair creds storage
 		return c
 
-	storeconfig key (Just cipher) = do
+	storeconfig creds key (Just cipher) = do
 		cmd <- gpgCmd <$> Annex.getGitConfig
-		s <- liftIO $ encrypt cmd (getGpgEncParams c) cipher
+		s <- liftIO $ encrypt cmd (c, nogitconfig) cipher
 			(feedBytes $ L.pack $ encodeCredPair creds)
 			(readBytes $ return . L.unpack)
 		return $ M.insert key (toB64 s) c
-	storeconfig key Nothing =
+	storeconfig creds key Nothing =
 		return $ M.insert key (toB64 $ encodeCredPair creds) c
+	-- This is used before a remote is set up typically, so
+	-- use a default RemoteGitConfig
+	nogitconfig :: RemoteGitConfig
+	nogitconfig = def
 
 {- Gets a remote's credpair, from the environment if set, otherwise
  - from the cache in gitAnnexCredsDir, or failing that, from the
  - value in RemoteConfig. -}
-getRemoteCredPair :: RemoteConfig -> CredPairStorage -> Annex (Maybe CredPair)
+getRemoteCredPair :: RemoteConfig -> RemoteGitConfig -> CredPairStorage -> Annex (Maybe CredPair)
-getRemoteCredPair c storage = maybe fromcache (return . Just) =<< fromenv
+getRemoteCredPair c gc storage = maybe fromcache (return . Just) =<< fromenv
   where
 	fromenv = liftIO $ getEnvCredPair storage
 	fromcache = maybe fromconfig (return . Just) =<< readCacheCredPair storage
@@ -94,7 +98,7 @@ getRemoteCredPair c storage = maybe fromcache (return . Just) =<< fromenv
 		Nothing -> return Nothing
 	fromenccreds enccreds cipher storablecipher = do
 		cmd <- gpgCmd <$> Annex.getGitConfig
-		mcreds <- liftIO $ catchMaybeIO $ decrypt cmd (getGpgDecParams c) cipher
+		mcreds <- liftIO $ catchMaybeIO $ decrypt cmd (c, gc) cipher
 			(feedBytes $ L.pack $ fromB64 enccreds)
 			(readBytes $ return . L.unpack)
 		case mcreds of
@@ -114,8 +118,8 @@ getRemoteCredPair c storage = maybe fromcache (return . Just) =<< fromenv
 			return $ Just credpair
 		_ -> error "bad creds"
 
-getRemoteCredPairFor :: String -> RemoteConfig -> CredPairStorage -> Annex (Maybe CredPair)
+getRemoteCredPairFor :: String -> RemoteConfig -> RemoteGitConfig -> CredPairStorage -> Annex (Maybe CredPair)
-getRemoteCredPairFor this c storage = go =<< getRemoteCredPair c storage
+getRemoteCredPairFor this c gc storage = go =<< getRemoteCredPair c gc storage
   where
 	go Nothing = do
 		warnMissingCredPairFor this storage

Crypto.hs

@@ -28,8 +28,7 @@ module Crypto (
 	readBytes,
 	encrypt,
 	decrypt,
-	getGpgEncParams,
+	LensGpgEncParams(..),
-	getGpgDecParams,
 
 	prop_HmacSha1WithCipher_sane
 ) where
@@ -179,24 +178,24 @@ readBytes a h = liftIO (L.hGetContents h) >>= a
 {- Runs a Feeder action, that generates content that is symmetrically
  - encrypted with the Cipher (unless it is empty, in which case
  - public-key encryption is used) using the given gpg options, and then
- - read by the Reader action.  Note: For public-key encryption,
+ - read by the Reader action. -}
- - recipients MUST be included in 'params' (for instance using
+encrypt :: (MonadIO m, MonadMask m, LensGpgEncParams c) => Gpg.GpgCmd -> c -> Cipher -> Feeder -> Reader m a -> m a
- - 'getGpgEncParams'). -}
+encrypt cmd c cipher = case cipher of
-encrypt :: (MonadIO m, MonadMask m) => Gpg.GpgCmd -> [CommandParam] -> Cipher -> Feeder -> Reader m a -> m a
-encrypt cmd params cipher = case cipher of
 	Cipher{} -> Gpg.feedRead cmd (params ++ Gpg.stdEncryptionParams True) $
 			cipherPassphrase cipher
 	MacOnlyCipher{} -> Gpg.pipeLazy cmd $ params ++ Gpg.stdEncryptionParams False
+  where
+	params = getGpgEncParams c
 
 {- Runs a Feeder action, that generates content that is decrypted with the
  - Cipher (or using a private key if the Cipher is empty), and read by the
  - Reader action. -}
-decrypt :: (MonadIO m, MonadMask m) => Gpg.GpgCmd -> [CommandParam] -> Cipher -> Feeder -> Reader m a -> m a
+decrypt :: (MonadIO m, MonadMask m, LensGpgEncParams c) => Gpg.GpgCmd -> c -> Cipher -> Feeder -> Reader m a -> m a
-decrypt cmd params cipher = case cipher of
+decrypt cmd c cipher = case cipher of
 	Cipher{} -> Gpg.feedRead cmd params' $ cipherPassphrase cipher
 	MacOnlyCipher{} -> Gpg.pipeLazy cmd params'
   where
-	params' = Param "--decrypt" : params
+	params' = Param "--decrypt" : getGpgDecParams c
 
 macWithCipher :: Mac -> Cipher -> String -> String
 macWithCipher mac c = macWithCipher' mac (cipherMac c)
@@ -218,20 +217,14 @@ class LensGpgEncParams a where
 {- Extract the GnuPG options from a pair of a Remote Config and a Remote
  - Git Config. -}
 instance LensGpgEncParams (RemoteConfig, RemoteGitConfig) where
-	getGpgEncParams (c,gc) = map Param (remoteAnnexGnupgOptions gc) ++ getGpgEncParams c
+	getGpgEncParams (c,gc) = map Param (remoteAnnexGnupgOptions gc) ++
-	getGpgDecParams (c,gc) = map Param (remoteAnnexGnupgDecryptOptions gc) ++ getGpgDecParams c
+ 		{- When the remote is configured to use public-key encryption,
-
+		 - look up the recipient keys and add them to the option list. -}
-{- Extract the GnuPG options from a Remote Config, ignoring any
+		case M.lookup "encryption" c of
- - git config settings. (Which is ok if the remote is just being set up 
+			Just "pubkey" -> Gpg.pkEncTo $ maybe [] (split ",") $ M.lookup "cipherkeys" c
- - and so doesn't have any.) -}
+			Just "sharedpubkey" -> Gpg.pkEncTo $ maybe [] (split ",") $ M.lookup "pubkeys" c
-instance LensGpgEncParams RemoteConfig where
+			_ -> []
- 	{- If the remote is configured to use public-key encryption,
+	getGpgDecParams (_c,gc) = map Param (remoteAnnexGnupgDecryptOptions gc)
-	 - look up the recipient keys and add them to the option list. -}
-	getGpgEncParams c = case M.lookup "encryption" c of
-		Just "pubkey" -> Gpg.pkEncTo $ maybe [] (split ",") $ M.lookup "cipherkeys" c
-		Just "sharedpubkey" -> Gpg.pkEncTo $ maybe [] (split ",") $ M.lookup "pubkeys" c
-		_ -> []
-	getGpgDecParams _ = []
 
 {- Extract the GnuPG options from a Remote. -}
 instance LensGpgEncParams (RemoteA a) where

Remote.hs

@@ -31,6 +31,7 @@ module Remote (
 	byNameOrGroup,
 	byNameOnly,
 	byNameWithUUID,
+	byUUID,
 	byCost,
 	prettyPrintUUIDs,
 	prettyPrintUUIDsDescs,
@@ -98,6 +99,11 @@ addName desc n
 	| desc == n || null desc = "[" ++ n ++ "]"
 	| otherwise = desc ++ " [" ++ n ++ "]"
 
+byUUID :: UUID -> Annex (Maybe Remote)
+byUUID u = headMaybe . filter matching <$> remoteList
+  where
+	matching r = uuid r == u
+
 {- When a name is specified, looks up the remote matching that name.
  - (Or it can be a UUID.)
  -

Remote/Bup.hs

@@ -90,8 +90,8 @@ gen r u c gc = do
 		{ chunkConfig = NoChunks
 		}
 
-bupSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
+bupSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-bupSetup mu _ c = do
+bupSetup mu _ c _ = do
 	u <- maybe (liftIO genUUID) return mu
 
 	-- verify configuration is sane

Remote/Ddar.hs

@@ -82,8 +82,8 @@ gen r u c gc = do
 		{ chunkConfig = NoChunks
 		}
 
-ddarSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
+ddarSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-ddarSetup mu _ c = do
+ddarSetup mu _ c _ = do
 	u <- maybe (liftIO genUUID) return mu
 
 	-- verify configuration is sane

Remote/Directory.hs

@@ -77,8 +77,8 @@ gen r u c gc = do
   where
 	dir = fromMaybe (error "missing directory") $ remoteAnnexDirectory gc
 
-directorySetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
+directorySetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-directorySetup mu _ c = do
+directorySetup mu _ c _ = do
 	u <- maybe (liftIO genUUID) return mu
 	-- verify configuration is sane
 	let dir = fromMaybe (error "Specify directory=") $

Remote/External.hs

@@ -59,7 +59,7 @@ gen r u c gc
 			Nothing
 			Nothing
 	| otherwise = do
-		external <- newExternal externaltype u c
+		external <- newExternal externaltype u c gc
 		Annex.addCleanup (RemoteCleanup u) $ stopExternal external
 		cst <- getCost external r gc
 		avail <- getAvailability external r gc
@@ -108,8 +108,8 @@ gen r u c gc
 			rmt
 	externaltype = fromMaybe (error "missing externaltype") (remoteAnnexExternalType gc)
 
-externalSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
+externalSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-externalSetup mu _ c = do
+externalSetup mu _ c gc = do
 	u <- maybe (liftIO genUUID) return mu
 	let externaltype = fromMaybe (error "Specify externaltype=") $
 		M.lookup "externaltype" c
@@ -120,7 +120,7 @@ externalSetup mu _ c = do
 			setConfig (remoteConfig (fromJust (M.lookup "name" c)) "readonly") (boolConfig True)
 			return c'
 		_ -> do
-			external <- newExternal externaltype u c'
+			external <- newExternal externaltype u c' gc
 			handleRequest external INITREMOTE Nothing $ \resp -> case resp of
 				INITREMOTE_SUCCESS -> Just noop
 				INITREMOTE_FAILURE errmsg -> Just $ error errmsg
@@ -246,8 +246,9 @@ handleRequest' lck external req mp responsehandler
 		void $ liftIO $ atomically $ swapTMVar (externalConfig external) c'
 	handleRemoteRequest (GETCREDS setting) = do
 		c <- liftIO $ atomically $ readTMVar $ externalConfig external
+		gc <- liftIO $ atomically $ readTMVar $ externalGitConfig external
 		creds <- fromMaybe ("", "") <$> 
-			getRemoteCredPair c (credstorage setting)
+			getRemoteCredPair c gc (credstorage setting)
 		send $ CREDS (fst creds) (snd creds)
 	handleRemoteRequest GETUUID = send $
 		VALUE $ fromUUID $ externalUUID external

Remote/External/Types.hs

@@ -54,15 +54,18 @@ data External = External
 	, externalLock :: TMVar ExternalLock
 	-- Never left empty.
 	, externalConfig :: TMVar RemoteConfig
+	-- Never left empty.
+	, externalGitConfig :: TMVar RemoteGitConfig
 	}
 
-newExternal :: ExternalType -> UUID -> RemoteConfig -> Annex External
+newExternal :: ExternalType -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex External
-newExternal externaltype u c = liftIO $ External
+newExternal externaltype u c gc = liftIO $ External
 	<$> pure externaltype
 	<*> pure u
 	<*> atomically newEmptyTMVar
 	<*> atomically (newTMVar ExternalLock)
 	<*> atomically (newTMVar c)
+	<*> atomically (newTMVar gc)
 
 type ExternalType = String
 

Remote/GCrypt.hs

@@ -169,8 +169,8 @@ noCrypto = error "cannot use gcrypt remote without encryption enabled"
 unsupportedUrl :: a
 unsupportedUrl = error "using non-ssh remote repo url with gcrypt is not supported"
 
-gCryptSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
+gCryptSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-gCryptSetup mu _ c = go $ M.lookup "gitrepo" c
+gCryptSetup mu _ c _ = go $ M.lookup "gitrepo" c
   where
 	remotename = fromJust (M.lookup "name" c)
 	go Nothing = error "Specify gitrepo="

Remote/Git.hs

@@ -93,8 +93,8 @@ list autoinit = do
  - No attempt is made to make the remote be accessible via ssh key setup,
  - etc.
  -}
-gitSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
+gitSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-gitSetup Nothing _ c = do
+gitSetup Nothing _ c _ = do
 	let location = fromMaybe (error "Specify location=url") $
 		Url.parseURIRelaxed =<< M.lookup "location" c
 	g <- Annex.gitRepo
@@ -103,7 +103,7 @@ gitSetup Nothing _ c = do
 		[] -> error "could not find existing git remote with specified location"
 		_ -> error "found multiple git remotes with specified location"
 	return (c, u)
-gitSetup (Just u) _ c = do
+gitSetup (Just u) _ c _ = do
 	inRepo $ Git.Command.run
 		[ Param "remote"
 		, Param "add"

Remote/Glacier.hs

@@ -78,17 +78,17 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost
 		{ chunkConfig = NoChunks
 		}
 
-glacierSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
+glacierSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-glacierSetup mu mcreds c = do
+glacierSetup mu mcreds c gc = do
 	u <- maybe (liftIO genUUID) return mu
-	glacierSetup' (isJust mu) u mcreds c
+	glacierSetup' (isJust mu) u mcreds c gc
-glacierSetup' :: Bool -> UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
+glacierSetup' :: Bool -> UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-glacierSetup' enabling u mcreds c = do
+glacierSetup' enabling u mcreds c gc = do
 	(c', encsetup) <- encryptionSetup c
 	c'' <- setRemoteCredPair encsetup c' (AWS.creds u) mcreds
 	let fullconfig = c'' `M.union` defaults
 	unless enabling $
-		genVault fullconfig u
+		genVault fullconfig gc u
 	gitConfigSpecialRemote u fullconfig "glacier" "true"
 	return (fullconfig, u)
   where
@@ -110,9 +110,10 @@ nonEmpty k
 	| otherwise = return True
 
 store :: Remote -> Key -> L.ByteString -> MeterUpdate -> Annex Bool
-store r k b p = go =<< glacierEnv c u
+store r k b p = go =<< glacierEnv c gc u
   where
 	c = config r
+	gc = gitconfig r
 	u = uuid r
 	params = glacierParams c
 		[ Param "archive"
@@ -133,9 +134,10 @@ prepareRetrieve :: Remote -> Preparer Retriever
 prepareRetrieve = simplyPrepare . byteRetriever . retrieve
 
 retrieve :: Remote -> Key -> (L.ByteString -> Annex Bool) -> Annex Bool
-retrieve r k sink = go =<< glacierEnv c u
+retrieve r k sink = go =<< glacierEnv c gc u
   where
 	c = config r
+	gc = gitconfig r
 	u = uuid r
 	params = glacierParams c
 		[ Param "archive"
@@ -178,7 +180,7 @@ remove r k = glacierAction r
 checkKey :: Remote -> CheckPresent
 checkKey r k = do
 	showChecking r
-	go =<< glacierEnv (config r) (uuid r)
+	go =<< glacierEnv (config r) (gitconfig r) (uuid r)
   where
 	go Nothing = error "cannot check glacier"
 	go (Just e) = do
@@ -207,10 +209,10 @@ checkKey r k = do
 			]
 
 glacierAction :: Remote -> [CommandParam] -> Annex Bool
-glacierAction r = runGlacier (config r) (uuid r)
+glacierAction r = runGlacier (config r) (gitconfig r) (uuid r)
 
-runGlacier :: RemoteConfig -> UUID -> [CommandParam] -> Annex Bool
+runGlacier :: RemoteConfig -> RemoteGitConfig -> UUID -> [CommandParam] -> Annex Bool
-runGlacier c u params = go =<< glacierEnv c u
+runGlacier c gc u params = go =<< glacierEnv c gc u
   where
 	go Nothing = return False
 	go (Just e) = liftIO $
@@ -223,10 +225,10 @@ glacierParams c params = datacenter:params
 		fromMaybe (error "Missing datacenter configuration")
 			(M.lookup "datacenter" c)
 
-glacierEnv :: RemoteConfig -> UUID -> Annex (Maybe [(String, String)])
+glacierEnv :: RemoteConfig -> RemoteGitConfig -> UUID -> Annex (Maybe [(String, String)])
-glacierEnv c u = do
+glacierEnv c gc u = do
 	liftIO checkSaneGlacierCommand
-	go =<< getRemoteCredPairFor "glacier" c creds
+	go =<< getRemoteCredPairFor "glacier" c gc creds
   where
 	go Nothing = return Nothing
 	go (Just (user, pass)) = do
@@ -245,8 +247,8 @@ archive r k = fileprefix ++ key2file k
   where
 	fileprefix = M.findWithDefault "" "fileprefix" $ config r
 
-genVault :: RemoteConfig -> UUID -> Annex ()
+genVault :: RemoteConfig -> RemoteGitConfig -> UUID -> Annex ()
-genVault c u = unlessM (runGlacier c u params) $
+genVault c gc u = unlessM (runGlacier c gc u params) $
 	error "Failed creating glacier vault."
   where
 	params = 
@@ -266,7 +268,7 @@ genVault c u = unlessM (runGlacier c u params) $
  - not supported.
  -}
 jobList :: Remote -> [Key] -> Annex ([Key], [Key])
-jobList r keys = go =<< glacierEnv (config r) (uuid r)
+jobList r keys = go =<< glacierEnv (config r) (gitconfig r) (uuid r)
   where
 	params = [ Param "job", Param "list" ]
 	nada = ([], [])

Remote/Helper/Special.hs

@@ -178,8 +178,6 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
 		}
 	cip = cipherKey c
 	isencrypted = isJust (extractCipher c)
-	gpgencopts = getGpgEncParams encr
-	gpgdecopts = getGpgDecParams encr
 
 	safely a = catchNonAsync a (\e -> warning (show e) >> return False)
 
@@ -201,7 +199,7 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
 	storechunk (Just (cipher, enck)) storer k content p = do
 		cmd <- gpgCmd <$> Annex.getGitConfig
 		withBytes content $ \b ->
-			encrypt cmd gpgencopts cipher (feedBytes b) $
+			encrypt cmd encr cipher (feedBytes b) $
 				readBytes $ \encb ->
 					storer (enck k) (ByteContent encb) p
 
@@ -211,7 +209,7 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
 	  where
 		go (Just retriever) = displayprogress p k $ \p' ->
 			retrieveChunks retriever (uuid baser) chunkconfig
-				enck k dest p' (sink dest enc gpgdecopts)
+				enck k dest p' (sink dest enc encr)
 		go Nothing = return False
 		enck = maybe id snd enc
 
@@ -244,26 +242,27 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
  - into place. (And it may even already be in the right place..)
  -}
 sink
-	:: FilePath
+	:: LensGpgEncParams c
+	=> FilePath
 	-> Maybe (Cipher, EncKey)
-	-> [CommandParam]
+	-> c
 	-> Maybe Handle
 	-> Maybe MeterUpdate
 	-> ContentSource
 	-> Annex Bool
-sink dest enc gpgdecopts mh mp content = do
+sink dest enc c mh mp content = do
 	case (enc, mh, content) of
 		(Nothing, Nothing, FileContent f)
 			| f == dest -> noop
 			| otherwise -> liftIO $ moveFile f dest
 		(Just (cipher, _), _, ByteContent b) -> do
 			cmd <- gpgCmd <$> Annex.getGitConfig
-			decrypt cmd gpgdecopts cipher (feedBytes b) $
+			decrypt cmd c cipher (feedBytes b) $
 				readBytes write
 		(Just (cipher, _), _, FileContent f) -> do
 			cmd <- gpgCmd <$> Annex.getGitConfig
 			withBytes content $ \b ->
-				decrypt cmd gpgdecopts cipher (feedBytes b) $
+				decrypt cmd c cipher (feedBytes b) $
 					readBytes write
 			liftIO $ nukeFile f
 		(Nothing, _, FileContent f) -> do

Remote/Hook.hs

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

Remote/Rsync.hs

@@ -137,8 +137,8 @@ rsyncTransport gc url
 	loginopt = maybe [] (\l -> ["-l",l]) login
 	fromNull as xs = if null xs then as else xs
 
-rsyncSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
+rsyncSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-rsyncSetup mu _ c = do
+rsyncSetup mu _ c _ = do
 	u <- maybe (liftIO genUUID) return mu
 	-- verify configuration is sane
 	let url = fromMaybe (error "Specify rsyncurl=") $

Remote/S3.hs

@@ -99,12 +99,14 @@ gen r u c gc = do
 			, checkUrl = Nothing
 			}
 
-s3Setup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
+s3Setup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-s3Setup mu mcreds c = do
+s3Setup mu mcreds c gc = do
 	u <- maybe (liftIO genUUID) return mu
-	s3Setup' (isNothing mu) u mcreds c
+	s3Setup' (isNothing mu) u mcreds c gc
-s3Setup' :: Bool -> UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
+s3Setup' :: Bool -> UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-s3Setup' new u mcreds c = if configIA c then archiveorg else defaulthost
+s3Setup' new u mcreds c gc
+	| configIA c = archiveorg
+	| otherwise = defaulthost
   where
 	remotename = fromJust (M.lookup "name" c)
 	defbucket = remotename ++ "-" ++ fromUUID u
@@ -125,7 +127,7 @@ s3Setup' new u mcreds c = if configIA c then archiveorg else defaulthost
 		c'' <- setRemoteCredPair encsetup c' (AWS.creds u) mcreds
 		let fullconfig = c'' `M.union` defaults
 		when new $
-			genBucket fullconfig u
+			genBucket fullconfig gc u
 		use fullconfig
 
 	archiveorg = do
@@ -146,7 +148,7 @@ s3Setup' new u mcreds c = if configIA c then archiveorg else defaulthost
 			-- special constraints on key names
 			M.insert "mungekeys" "ia" defaults
 		info <- extractS3Info archiveconfig
-		withS3Handle archiveconfig u $
+		withS3Handle archiveconfig gc u $
 			writeUUIDFile archiveconfig u info
 		use archiveconfig
 
@@ -154,12 +156,12 @@ s3Setup' new u mcreds c = if configIA c then archiveorg else defaulthost
 -- http connections to be reused across calls to the helper.
 prepareS3Handle :: Remote -> (S3Handle -> helper) -> Preparer helper
 prepareS3Handle r = resourcePrepare $ const $
-	withS3Handle (config r) (uuid r)
+	withS3Handle (config r) (gitconfig r) (uuid r)
 
 -- Allows for read-only actions, which can be run without a S3Handle.
 prepareS3HandleMaybe :: Remote -> (Maybe S3Handle -> helper) -> Preparer helper
 prepareS3HandleMaybe r = resourcePrepare $ const $
-	withS3HandleMaybe (config r) (uuid r)
+	withS3HandleMaybe (config r) (gitconfig r) (uuid r)
 
 store :: Remote -> S3Info -> S3Handle -> Storer
 store _r info h = fileStorer $ \k f p -> do
@@ -311,11 +313,11 @@ checkKey r info Nothing k = case getpublicurl info of
  - so first check if the UUID file already exists and we can skip doing
  - anything.
  -}
-genBucket :: RemoteConfig -> UUID -> Annex ()
+genBucket :: RemoteConfig -> RemoteGitConfig -> UUID -> Annex ()
-genBucket c u = do
+genBucket c gc u = do
 	showAction "checking bucket"
 	info <- extractS3Info c
-	withS3Handle c u $ \h ->
+	withS3Handle c gc u $ \h ->
 		go info h =<< checkUUIDFile c u info h
   where
 	go _ _ (Right True) = noop
@@ -408,16 +410,16 @@ sendS3Handle'
 	-> ResourceT IO a
 sendS3Handle' h r = AWS.pureAws (hawscfg h) (hs3cfg h) (hmanager h) r
 
-withS3Handle :: RemoteConfig -> UUID -> (S3Handle -> Annex a) -> Annex a
+withS3Handle :: RemoteConfig -> RemoteGitConfig -> UUID -> (S3Handle -> Annex a) -> Annex a
-withS3Handle c u a = withS3HandleMaybe c u $ \mh -> case mh of
+withS3Handle c gc u a = withS3HandleMaybe c gc u $ \mh -> case mh of
 	Just h -> a h
 	Nothing -> do
 		warnMissingCredPairFor "S3" (AWS.creds u)
 		error "No S3 credentials configured"
 
-withS3HandleMaybe :: RemoteConfig -> UUID -> (Maybe S3Handle -> Annex a) -> Annex a
+withS3HandleMaybe :: RemoteConfig -> RemoteGitConfig -> UUID -> (Maybe S3Handle -> Annex a) -> Annex a
-withS3HandleMaybe c u a = do
+withS3HandleMaybe c gc u a = do
-	mcreds <- getRemoteCredPair c (AWS.creds u)
+	mcreds <- getRemoteCredPair c gc (AWS.creds u)
 	case mcreds of
 		Just creds -> do
 			awscreds <- liftIO $ genCredentials creds

Remote/Tahoe.hs

@@ -91,8 +91,8 @@ gen r u c gc = do
 		, checkUrl = Nothing
 		}
 
-tahoeSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
+tahoeSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-tahoeSetup mu _ c = do
+tahoeSetup mu _ c _ = do
 	furl <- fromMaybe (fromMaybe missingfurl $ M.lookup furlk c)
 		<$> liftIO (getEnv "TAHOE_FURL")
 	u <- maybe (liftIO genUUID) return mu

Remote/WebDAV.hs

@@ -81,14 +81,14 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
 			}
 		chunkconfig = getChunkConfig c
 
-webdavSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
+webdavSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-webdavSetup mu mcreds c = do
+webdavSetup mu mcreds c gc = do
 	u <- maybe (liftIO genUUID) return mu
 	url <- case M.lookup "url" c of
 		Nothing -> error "Specify url="
 		Just url -> return url
 	(c', encsetup) <- encryptionSetup c
-	creds <- maybe (getCreds c' u) (return . Just) mcreds
+	creds <- maybe (getCreds c' gc u) (return . Just) mcreds
 	testDav url creds
 	gitConfigSpecialRemote u c' "webdav" "true"
 	c'' <- setRemoteCredPair encsetup c' (davCreds u) creds
@@ -234,8 +234,8 @@ mkColRecursive d = go =<< existsDAV d
 			inLocation d mkCol
 		)
 
-getCreds :: RemoteConfig -> UUID -> Annex (Maybe CredPair)
+getCreds :: RemoteConfig -> RemoteGitConfig -> UUID -> Annex (Maybe CredPair)
-getCreds c u = getRemoteCredPairFor "webdav" c (davCreds u)
+getCreds c gc u = getRemoteCredPairFor "webdav" c gc (davCreds u)
 
 davCreds :: UUID -> CredPairStorage
 davCreds u = CredPairStorage
@@ -291,7 +291,7 @@ data DavHandle = DavHandle DAVContext DavUser DavPass URLString
 
 withDAVHandle :: Remote -> (Maybe DavHandle -> Annex a) -> Annex a
 withDAVHandle r a = do
-	mcreds <- getCreds (config r) (uuid r)
+	mcreds <- getCreds (config r) (gitconfig r) (uuid r)
 	case (mcreds, configUrl r) of
 		(Just (user, pass), Just baseurl) ->
 			withDAVContext baseurl $ \ctx ->

Types/Remote.hs

@@ -50,7 +50,7 @@ data RemoteTypeA a = RemoteType {
 	-- generates a remote of this type
 	generate :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> a (Maybe (RemoteA a)),
 	-- initializes or changes a remote
-	setup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> a (RemoteConfig, UUID)
+	setup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> a (RemoteConfig, UUID)
 }
 
 instance Eq (RemoteTypeA a) where

debian/changelog

@@ -20,6 +20,8 @@ git-annex (6.20160512) UNRELEASED; urgency=medium
   * Fix crash when entering/changing view in a subdirectory of a repo that
     has a dotfile in its root.
   * Support building with ghc 8.0.1.
+  * Pass the various gnupg-options configs to gpg in several cases where
+    they were not before.
 
  -- Joey Hess <id@joeyh.name>  Wed, 11 May 2016 16:08:38 -0400