diff options
author | 2016-09-30 14:29:02 -0400 | |
---|---|---|
committer | 2016-09-30 14:29:02 -0400 | |
commit | f42a64198f18708623fc7a6f7e53cfb3b9e5642b (patch) | |
tree | 89c46dc442fe8eddc1999032472cc0579ce79f4a /Remote/External/Types.hs | |
parent | ff84a7d05050da889da5e48b85067186616da80f (diff) |
allow multiple concurrent external special remote processes
Multiple external special remote processes for the same remote will be
started as needed when using -J.
This should not beak any existing external special remotes, because running
multiple git-annex commands at the same time could already start multiple
processes for the same external special remotes.
Diffstat (limited to 'Remote/External/Types.hs')
-rw-r--r-- | Remote/External/Types.hs | 28 |
1 files changed, 7 insertions, 21 deletions
diff --git a/Remote/External/Types.hs b/Remote/External/Types.hs index 8098826b2..98d391df8 100644 --- a/Remote/External/Types.hs +++ b/Remote/External/Types.hs @@ -12,8 +12,6 @@ module Remote.External.Types ( External(..), newExternal, ExternalType, - ExternalLock, - withExternalLock, ExternalState(..), PrepareStatus(..), Proto.parseMessage, @@ -44,14 +42,12 @@ import qualified Utility.SimpleProtocol as Proto import Control.Concurrent.STM import Network.URI --- If the remote is not yet running, the ExternalState TMVar is empty. data External = External { externalType :: ExternalType , externalUUID :: UUID - -- Empty until the remote is running. - , externalState :: TMVar ExternalState - -- Empty when a remote is in use. - , externalLock :: TMVar ExternalLock + , externalState :: TMVar [ExternalState] + -- ^ TMVar is never left empty; list contains states for external + -- special remote processes that are not currently in use. , externalDefaultConfig :: RemoteConfig , externalGitConfig :: RemoteGitConfig } @@ -60,8 +56,7 @@ newExternal :: ExternalType -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex newExternal externaltype u c gc = liftIO $ External <$> pure externaltype <*> pure u - <*> atomically newEmptyTMVar - <*> atomically (newTMVar ExternalLock) + <*> atomically (newTMVar []) <*> pure c <*> pure gc @@ -71,23 +66,14 @@ data ExternalState = ExternalState { externalSend :: Handle , externalReceive :: Handle , externalShutdown :: IO () - , externalPrepared :: PrepareStatus - -- Never left empty. + , externalPrepared :: TMVar PrepareStatus + -- ^ Never left empty. , externalConfig :: TMVar RemoteConfig + -- ^ Never left empty. } data PrepareStatus = Unprepared | Prepared | FailedPrepare ErrorMsg --- Constructor is not exported, and only created by newExternal. -data ExternalLock = ExternalLock - -withExternalLock :: External -> (ExternalLock -> Annex a) -> Annex a -withExternalLock external = bracketIO setup cleanup - where - setup = atomically $ takeTMVar v - cleanup = atomically . putTMVar v - v = externalLock external - -- Messages that can be sent to the external remote to request it do something. data Request = PREPARE |