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.
This commit is contained in:
parent
9418b516ac
commit
de564df8b3
2 changed files with 14 additions and 2 deletions
|
@ -2,6 +2,7 @@ git-annex (7.20190913) UNRELEASED; urgency=medium
|
||||||
|
|
||||||
* Added --mimetype and --mimeencoding file matching options.
|
* Added --mimetype and --mimeencoding file matching options.
|
||||||
* Added --unlocked and --locked 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
|
-- Joey Hess <id@joeyh.name> Thu, 19 Sep 2019 11:11:19 -0400
|
||||||
|
|
||||||
|
|
|
@ -42,6 +42,7 @@ import qualified Data.Map as M
|
||||||
import qualified Data.ByteString.Lazy as L
|
import qualified Data.ByteString.Lazy as L
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.Encoding as E
|
import qualified Data.Text.Encoding as E
|
||||||
|
import qualified Control.Concurrent.MSemN as MSemN
|
||||||
|
|
||||||
remote :: RemoteType
|
remote :: RemoteType
|
||||||
remote = RemoteType
|
remote = RemoteType
|
||||||
|
@ -64,7 +65,8 @@ gen r u c gc = do
|
||||||
g <- Annex.gitRepo
|
g <- Annex.gitRepo
|
||||||
liftIO $ Git.GCrypt.encryptedRemote g r
|
liftIO $ Git.GCrypt.encryptedRemote g r
|
||||||
else pure 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
|
cst <- remoteCost gc expensiveRemoteCost
|
||||||
return $ Just $ specialRemote' specialcfg c
|
return $ Just $ specialRemote' specialcfg c
|
||||||
(simplyPrepare $ store u h)
|
(simplyPrepare $ store u h)
|
||||||
|
@ -159,10 +161,19 @@ mySetup _ mu _ c gc = do
|
||||||
data LFSHandle = LFSHandle
|
data LFSHandle = LFSHandle
|
||||||
{ downloadEndpoint :: Maybe LFS.Endpoint
|
{ downloadEndpoint :: Maybe LFS.Endpoint
|
||||||
, uploadEndpoint :: Maybe LFS.Endpoint
|
, uploadEndpoint :: Maybe LFS.Endpoint
|
||||||
|
, getEndPointLock :: MSemN.MSemN Int
|
||||||
, remoteRepo :: Git.Repo
|
, remoteRepo :: Git.Repo
|
||||||
, remoteGitConfig :: RemoteGitConfig
|
, 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 :: LFS.TransferRequestOperation -> LFSHandle -> Annex (Maybe LFS.Endpoint)
|
||||||
discoverLFSEndpoint tro h
|
discoverLFSEndpoint tro h
|
||||||
| Git.repoIsSsh r = gossh
|
| Git.repoIsSsh r = gossh
|
||||||
|
@ -223,7 +234,7 @@ getLFSEndpoint tro hv = do
|
||||||
h <- liftIO $ atomically $ readTVar hv
|
h <- liftIO $ atomically $ readTVar hv
|
||||||
case f h of
|
case f h of
|
||||||
Just endpoint -> return (Just endpoint)
|
Just endpoint -> return (Just endpoint)
|
||||||
Nothing -> discoverLFSEndpoint tro h >>= \case
|
Nothing -> withEndPointLock h $ discoverLFSEndpoint tro h >>= \case
|
||||||
Just endpoint -> do
|
Just endpoint -> do
|
||||||
liftIO $ atomically $ writeTVar hv $
|
liftIO $ atomically $ writeTVar hv $
|
||||||
case tro of
|
case tro of
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue