diff options
author | Joey Hess <joey@kitenet.net> | 2012-11-11 16:23:16 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-11-11 16:23:16 -0400 |
commit | 6068fd160ffeb930368a4c4c2a8818ace71f29ab (patch) | |
tree | 3f5a183e9594854a55f17cfdca740516943084c6 /Assistant/DaemonStatus.hs | |
parent | 0d21e323e0d095232e347859adaaf2cc2cd71592 (diff) |
don't try to transfer data to/from XMPP remotes
Partition syncRemotes into ones needing git sync (ie, non-special remotes),
and ones needing data sync (ie, non-XMPP remotes).
Diffstat (limited to 'Assistant/DaemonStatus.hs')
-rw-r--r-- | Assistant/DaemonStatus.hs | 32 |
1 files changed, 23 insertions, 9 deletions
diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs index a93f4105a..8a4a7a16d 100644 --- a/Assistant/DaemonStatus.hs +++ b/Assistant/DaemonStatus.hs @@ -10,11 +10,13 @@ module Assistant.DaemonStatus where import Assistant.Common import Assistant.Alert import Utility.TempFile +import Assistant.Types.NetMessager import Utility.NotificationBroadcaster import Logs.Transfer import Logs.Trust import qualified Remote import qualified Types.Remote as Remote +import qualified Git import Config import Control.Concurrent.STM @@ -23,6 +25,7 @@ import Data.Time.Clock.POSIX import Data.Time import System.Locale import qualified Data.Map as M +import qualified Data.Text as T getDaemonStatus :: Assistant DaemonStatus getDaemonStatus = (atomically . readTMVar) <<~ daemonStatusHandle @@ -41,20 +44,23 @@ modifyDaemonStatus a = do sendNotification $ changeNotifier s return b -{- Syncable remotes ordered by cost. -} -calcSyncRemotes :: Annex [Remote] +{- Returns a function that updates the lists of syncable remotes. -} +calcSyncRemotes :: Annex (DaemonStatus -> DaemonStatus) calcSyncRemotes = do rs <- filterM (repoSyncable . Remote.repo) =<< concat . Remote.byCost <$> Remote.enabledRemoteList alive <- trustExclude DeadTrusted (map Remote.uuid rs) let good r = Remote.uuid r `elem` alive - return $ filter good rs + let syncable = filter good rs + return $ \dstatus -> dstatus + { syncRemotes = syncable + , syncGitRemotes = filter (not . Remote.specialRemote) syncable + , syncDataRemotes = filter (not . isXMPPRemote) syncable + } {- Updates the sycRemotes list from the list of all remotes in Annex state. -} updateSyncRemotes :: Assistant () -updateSyncRemotes = do - remotes <- liftAnnex calcSyncRemotes - modifyDaemonStatus_ $ \s -> s { syncRemotes = remotes } +updateSyncRemotes = modifyDaemonStatus_ =<< liftAnnex calcSyncRemotes {- Load any previous daemon status file, and store it in a MVar for this - process to use as its DaemonStatus. Also gets current transfer status. -} @@ -64,12 +70,11 @@ startDaemonStatus = do status <- liftIO $ flip catchDefaultIO (readDaemonStatusFile file) =<< newDaemonStatus transfers <- M.fromList <$> getTransfers - remotes <- calcSyncRemotes - liftIO $ atomically $ newTMVar status + addsync <- calcSyncRemotes + liftIO $ atomically $ newTMVar $ addsync $ status { scanComplete = False , sanityCheckRunning = False , currentTransfers = transfers - , syncRemotes = remotes } {- Don't just dump out the structure, because it will change over time, @@ -221,3 +226,12 @@ alertDuring :: Alert -> Assistant a -> Assistant a alertDuring alert a = do i <- addAlert $ alert { alertClass = Activity } removeAlert i `after` a + +{- Remotes using the XMPP transport have urls like xmpp::user@host -} +isXMPPRemote :: Remote -> Bool +isXMPPRemote remote = Git.repoIsUrl r && "xmpp::" `isPrefixOf` Git.repoLocation r + where + r = Remote.repo remote + +getXMPPClientID :: Remote -> ClientID +getXMPPClientID r = T.pack $ drop (length "xmpp::") (Git.repoLocation (Remote.repo r)) |