From de564df8b34c84a35db0c654c8208c4f73fa803b Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 24 Sep 2019 13:01:51 -0400
Subject: [PATCH] git-lfs: Only do endpoint discovery once when concurrency is
 enabled

This avoids some extra work, but I don't think it was possible for two ssh
endpoint discoveries run concurrently to both prompt for the ssh password;
Annex.Ssh itself deals with concurrency.

This is mostly groundwork for http password prompting.
---
 CHANGELOG        |  1 +
 Remote/GitLFS.hs | 15 +++++++++++++--
 2 files changed, 14 insertions(+), 2 deletions(-)

diff --git a/CHANGELOG b/CHANGELOG
index f3ff7ebe44..daa8e76454 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -2,6 +2,7 @@ git-annex (7.20190913) UNRELEASED; urgency=medium
 
   * Added --mimetype and --mimeencoding file matching options.
   * Added --unlocked and --locked file matching options.
+  * git-lfs: Only do endpoint discovery once when concurrency is enabled.
 
  -- Joey Hess <id@joeyh.name>  Thu, 19 Sep 2019 11:11:19 -0400
 
diff --git a/Remote/GitLFS.hs b/Remote/GitLFS.hs
index 4765d2fddb..dde6a3355f 100644
--- a/Remote/GitLFS.hs
+++ b/Remote/GitLFS.hs
@@ -42,6 +42,7 @@ import qualified Data.Map as M
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
+import qualified Control.Concurrent.MSemN as MSemN
 
 remote :: RemoteType
 remote = RemoteType
@@ -64,7 +65,8 @@ gen r u c gc = do
 			g <- Annex.gitRepo
 			liftIO $ Git.GCrypt.encryptedRemote g r
 		else pure r
-	h <- liftIO $ newTVarIO $ LFSHandle Nothing Nothing r' gc
+	sem <- liftIO $ MSemN.new 1
+	h <- liftIO $ newTVarIO $ LFSHandle Nothing Nothing sem r' gc
 	cst <- remoteCost gc expensiveRemoteCost
 	return $ Just $ specialRemote' specialcfg c
 		(simplyPrepare $ store u h)
@@ -159,10 +161,19 @@ mySetup _ mu _ c gc = do
 data LFSHandle = LFSHandle
 	{ downloadEndpoint :: Maybe LFS.Endpoint
 	, uploadEndpoint :: Maybe LFS.Endpoint
+	, getEndPointLock :: MSemN.MSemN Int 
 	, remoteRepo :: Git.Repo
 	, remoteGitConfig :: RemoteGitConfig
 	}
 
+-- Only let one thread at a time do endpoint discovery.
+withEndPointLock :: LFSHandle -> Annex a -> Annex a
+withEndPointLock h = bracket_
+	(liftIO $ MSemN.wait l 1)
+	(liftIO $ MSemN.signal l 1)
+  where
+	l = getEndPointLock h
+
 discoverLFSEndpoint :: LFS.TransferRequestOperation -> LFSHandle -> Annex (Maybe LFS.Endpoint)
 discoverLFSEndpoint tro h
 	| Git.repoIsSsh r = gossh
@@ -223,7 +234,7 @@ getLFSEndpoint tro hv = do
 	h <- liftIO $ atomically $ readTVar hv
 	case f h of
 		Just endpoint -> return (Just endpoint)
-		Nothing -> discoverLFSEndpoint tro h >>= \case
+		Nothing -> withEndPointLock h $ discoverLFSEndpoint tro h >>= \case
 			Just endpoint -> do
 				liftIO $ atomically $ writeTVar hv $
 					case tro of