Avoid more than 1 gpg password prompt at the same time

Which could happen occasionally before when concurrency is enabled.
While not much of a problem when it did happen, better to avoid it. Also,
since it seems likely the gpg-agent sometimes fails in such a situation,
this makes it not happen when running a single git-annex command with
concurrency enabled.

This commit was sponsored by Jake Vosloo on Patreon.

Annex.hs

@@ -122,6 +122,7 @@ data AnnexRead = AnnexRead
 	, transferrerpool :: TransferrerPool
 	, debugenabled :: Bool
 	, debugselector :: DebugSelector
+	, ciphers :: TMVar (M.Map StorableCipher Cipher)
 	}
 
 newAnnexRead :: GitConfig -> IO AnnexRead
@@ -132,6 +133,7 @@ newAnnexRead c = do
 	sc <- newTMVarIO False
 	si <- newTVarIO M.empty
 	tp <- newTransferrerPool
+	cm <- newTMVarIO M.empty
 	return $ AnnexRead
 		{ activekeys = emptyactivekeys
 		, activeremotes = emptyactiveremotes
@@ -141,6 +143,7 @@ newAnnexRead c = do
 		, transferrerpool = tp
 		, debugenabled = annexDebug c
 		, debugselector = debugSelectorFromGitConfig c
+		, ciphers = cm
 		}
 
 -- Values that can change while running an Annex action.
@@ -178,7 +181,6 @@ data AnnexState = AnnexState
 	, forcetrust :: TrustMap
 	, trustmap :: Maybe TrustMap
 	, groupmap :: Maybe GroupMap
-	, ciphers :: M.Map StorableCipher Cipher
 	, lockcache :: LockCache
 	, flags :: M.Map String Bool
 	, fields :: M.Map String String
@@ -237,7 +239,6 @@ newAnnexState c r = do
 		, forcetrust = M.empty
 		, trustmap = Nothing
 		, groupmap = Nothing
-		, ciphers = M.empty
 		, lockcache = M.empty
 		, flags = M.empty
 		, fields = M.empty

CHANGELOG

@@ -25,6 +25,8 @@ git-annex (8.20210331) UNRELEASED; urgency=medium
     mincopies is satisfied. Before, it assumed a sane configuration would
     have numcopies larger or equal to mincopies. It's still a good idea
     not to configure git-annex this way.
+  * Avoid more than 1 gpg password prompt at the same time, which
+    could happen occasionally before when concurrency is enabled.
   * Fix build with persistent-2.12.0.1
 
  -- Joey Hess <id@joeyh.name>  Thu, 01 Apr 2021 12:17:26 -0400

Remote/Helper/Encryptable.hs

@@ -1,6 +1,6 @@
 {- common functions for encryptable remotes
  -
- - Copyright 2011-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2021 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -30,6 +30,7 @@ import qualified Data.Map as M
 import qualified Data.Set as S
 import qualified "sandi" Codec.Binary.Base64 as B64
 import qualified Data.ByteString as B
+import Control.Concurrent.STM
 
 import Annex.Common
 import Types.Remote
@@ -218,17 +219,28 @@ remoteCipher c gc = fmap fst <$> remoteCipher' c gc
 {- Gets encryption Cipher. The decrypted Ciphers are cached in the Annex
  - state. -}
 remoteCipher' :: ParsedRemoteConfig -> RemoteGitConfig -> Annex (Maybe (Cipher, StorableCipher))
-remoteCipher' c gc = go $ extractCipher c
-  where
-	go Nothing = return Nothing
-	go (Just encipher) = do
-		cache <- Annex.getState Annex.ciphers
-		case M.lookup encipher cache of
+remoteCipher' c gc = case extractCipher c of
+	Nothing -> return Nothing
+	Just encipher -> do
+		cachev <- Annex.getRead Annex.ciphers
+		cachedciper <- liftIO $ atomically $ 
+			M.lookup encipher <$> readTMVar cachev
+		case cachedciper of
 			Just cipher -> return $ Just (cipher, encipher)
-			Nothing -> do
+			-- Not cached; decrypt it, making sure
+			-- to only decrypt one at a time. Avoids
+			-- prompting for decrypting the same thing twice
+			-- when this is run concurrently.
+			Nothing -> bracketOnError
+				(liftIO $ atomically $ takeTMVar cachev)
+				(liftIO . atomically . putTMVar cachev)
+				(go cachev encipher)
+  where
+	go cachev encipher cache = do
 		cmd <- gpgCmd <$> Annex.getGitConfig
 		cipher <- liftIO $ decryptCipher cmd (c, gc) encipher
-				Annex.changeState (\s -> s { Annex.ciphers = M.insert encipher cipher cache })
+		liftIO $ atomically $ putTMVar cachev $
+			M.insert encipher cipher cache
 		return $ Just (cipher, encipher)
 
 {- Checks if the remote's config allows storing creds in the remote's config.

doc/bugs/fsck_of_encrypted_remote_fails_w__47___multiple_jobs/comment_3_f053194ba612d1aa1ecddb8c9bf843ae._comment

@@ -0,0 +1,13 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 3"""
+ date="2021-04-27T20:33:41Z"
+ content="""
+I've implemented the race protection. Pretty sure this fixes it, at least
+to the extent it can be fixed if it's a gpg bug that any 2 concurrent
+password prompts can sometimes trigger. I'll run git-annex fsck in a
+loop for an hour or so to be more sure.
+
+It would be nice if someone wants to file a bug on gpg, but I don't have
+time right now.
+"""]]