diff options
Diffstat (limited to 'RemoteDaemon/Core.hs')
-rw-r--r-- | RemoteDaemon/Core.hs | 41 |
1 files changed, 23 insertions, 18 deletions
diff --git a/RemoteDaemon/Core.hs b/RemoteDaemon/Core.hs index 8960bf8d3..cd4a0aaed 100644 --- a/RemoteDaemon/Core.hs +++ b/RemoteDaemon/Core.hs @@ -10,15 +10,17 @@ module RemoteDaemon.Core (runForeground) where import qualified Annex import Common import Types.GitConfig +import RemoteDaemon.Common import RemoteDaemon.Types import RemoteDaemon.Transport import qualified Git import qualified Git.Types as Git import qualified Git.CurrentRepo import Utility.SimpleProtocol +import Config import Control.Concurrent.Async -import Control.Concurrent.Chan +import Control.Concurrent import Network.URI import qualified Data.Map as M @@ -50,36 +52,38 @@ type RemoteMap = M.Map Git.Repo (IO (), Chan Consumed) -- the main control messages. controller :: Chan Consumed -> Chan Emitted -> IO () controller ichan ochan = do - m <- getRemoteMap ochan + h <- genTransportHandle + m <- genRemoteMap h ochan startrunning m - go False m + go h False m where - go paused m = do + go h paused m = do cmd <- readChan ichan case cmd of RELOAD -> do - m' <- getRemoteMap ochan + liftAnnex h reloadConfig + m' <- genRemoteMap h ochan let common = M.intersection m m' let new = M.difference m' m let old = M.difference m m' stoprunning old unless paused $ startrunning new - go paused (M.union common new) + go h paused (M.union common new) PAUSE -> do stoprunning m - go True m + go h True m RESUME -> do when paused $ startrunning m - go False m + go h False m STOP -> exitSuccess -- All remaining messages are sent to -- all Transports. msg -> do unless paused $ forM_ chans (`writeChan` msg) - go paused m + go h paused m where chans = map snd (M.elems m) @@ -90,17 +94,12 @@ controller ichan ochan = do stoprunning m = forM_ (M.elems m) stoprunning' stoprunning' (_, c) = writeChan c STOP -getRemoteMap :: Chan Emitted -> IO RemoteMap -getRemoteMap ochan = do - annexstate <- Annex.new =<< Git.CurrentRepo.get - genRemoteMap annexstate ochan - -- Generates a map with a transport for each supported remote in the git repo, -- except those that have annex.sync = false -genRemoteMap :: Annex.AnnexState -> Chan Emitted -> IO RemoteMap -genRemoteMap annexstate ochan = M.fromList . catMaybes <$> mapM gen rs +genRemoteMap :: TransportHandle -> Chan Emitted -> IO RemoteMap +genRemoteMap h@(TransportHandle g _) ochan = + M.fromList . catMaybes <$> mapM gen (Git.remotes g) where - rs = Git.remotes (Annex.repo annexstate) gen r = case Git.location r of Git.Url u -> case M.lookup (uriScheme u) remoteTransports of Just transport @@ -108,7 +107,13 @@ genRemoteMap annexstate ochan = M.fromList . catMaybes <$> mapM gen rs ichan <- newChan :: IO (Chan Consumed) return $ Just ( r - , (transport r (Git.repoDescribe r) annexstate ichan ochan, ichan) + , (transport r (Git.repoDescribe r) h ichan ochan, ichan) ) _ -> return Nothing _ -> return Nothing + +genTransportHandle :: IO TransportHandle +genTransportHandle = do + annexstate <- newMVar =<< Annex.new =<< Git.CurrentRepo.get + g <- Annex.repo <$> readMVar annexstate + return $ TransportHandle g annexstate |