diff options
author | Joey Hess <joeyh@joeyh.name> | 2016-11-14 14:26:20 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2016-11-14 14:53:08 -0400 |
commit | 34f375526f44ff255d45bbabcd1425b3d5d0bb4a (patch) | |
tree | a78e27f5e125587828f30af3abef691b33baae88 /Assistant/Sync.hs | |
parent | e7088c519678f63f460646cc19c3e25423da4f00 (diff) |
remove xmpp support
I've long considered the XMPP support in git-annex a wart.
It's nice to remove it.
(This also removes the NetMessager, which was only used for XMPP, and the
daemonstatus's desynced list (likewise).)
Existing XMPP remotes should be ignored by git-annex.
This commit was sponsored by Brock Spratlen on Patreon.
Diffstat (limited to 'Assistant/Sync.hs')
-rw-r--r-- | Assistant/Sync.hs | 66 |
1 files changed, 14 insertions, 52 deletions
diff --git a/Assistant/Sync.hs b/Assistant/Sync.hs index 9b9e7ebe5..e46910ccd 100644 --- a/Assistant/Sync.hs +++ b/Assistant/Sync.hs @@ -9,8 +9,6 @@ module Assistant.Sync where import Assistant.Common import Assistant.Pushes -import Assistant.NetMessager -import Assistant.Types.NetMessager import Assistant.Alert import Assistant.Alert.Utility import Assistant.DaemonStatus @@ -20,7 +18,6 @@ import qualified Command.Sync import Utility.Parallel import qualified Git import qualified Git.Command -import qualified Git.Ref import qualified Git.Merge import qualified Remote import qualified Types.Remote as Remote @@ -40,7 +37,6 @@ import Types.Transfer import Data.Time.Clock import qualified Data.Map as M -import qualified Data.Set as S import Control.Concurrent {- Syncs with remotes that may have been disconnected for a while. @@ -51,21 +47,14 @@ import Control.Concurrent - the remotes have diverged from the local git-annex branch. Otherwise, - it's sufficient to requeue failed transfers. - - - XMPP remotes are also signaled that we can push to them, and we request - - they push to us. Since XMPP pushes run ansynchronously, any scan of the - - XMPP remotes has to be deferred until they're done pushing to us, so - - all XMPP remotes are marked as possibly desynced. - - - Also handles signaling any connectRemoteNotifiers, after the syncing is - done. -} -reconnectRemotes :: Bool -> [Remote] -> Assistant () -reconnectRemotes _ [] = noop -reconnectRemotes notifypushes rs = void $ do +reconnectRemotes :: [Remote] -> Assistant () +reconnectRemotes [] = noop +reconnectRemotes rs = void $ do rs' <- liftIO $ filterM (Remote.checkAvailable True) rs unless (null rs') $ do - modifyDaemonStatus_ $ \s -> s - { desynced = S.union (S.fromList $ map Remote.uuid xmppremotes) (desynced s) } failedrs <- syncAction rs' (const go) forM_ failedrs $ \r -> whenM (liftIO $ Remote.checkAvailable False r) $ @@ -73,7 +62,7 @@ reconnectRemotes notifypushes rs = void $ do mapM_ signal $ filter (`notElem` failedrs) rs' where gitremotes = filter (notspecialremote . Remote.repo) rs - (xmppremotes, nonxmppremotes) = partition Remote.isXMPPRemote rs + (_xmppremotes, nonxmppremotes) = partition Remote.isXMPPRemote rs notspecialremote r | Git.repoIsUrl r = True | Git.repoIsLocal r = True @@ -82,7 +71,7 @@ reconnectRemotes notifypushes rs = void $ do sync currentbranch@(Just _, _) = do (failedpull, diverged) <- manualPull currentbranch gitremotes now <- liftIO getCurrentTime - failedpush <- pushToRemotes' now notifypushes gitremotes + failedpush <- pushToRemotes' now gitremotes return (nub $ failedpull ++ failedpush, diverged) {- No local branch exists yet, but we can try pulling. -} sync (Nothing, _) = manualPull (Nothing, Nothing) gitremotes @@ -102,9 +91,6 @@ reconnectRemotes notifypushes rs = void $ do - as "git annex sync", except in parallel, and will co-exist with use of - "git annex sync". - - - After the pushes to normal git remotes, also signals XMPP clients that - - they can request an XMPP push. - - - Avoids running possibly long-duration commands in the Annex monad, so - as not to block other threads. - @@ -122,27 +108,21 @@ reconnectRemotes notifypushes rs = void $ do - - Returns any remotes that it failed to push to. -} -pushToRemotes :: Bool -> [Remote] -> Assistant [Remote] -pushToRemotes notifypushes remotes = do +pushToRemotes :: [Remote] -> Assistant [Remote] +pushToRemotes remotes = do now <- liftIO getCurrentTime let remotes' = filter (not . remoteAnnexReadOnly . Remote.gitconfig) remotes - syncAction remotes' (pushToRemotes' now notifypushes) -pushToRemotes' :: UTCTime -> Bool -> [Remote] -> Assistant [Remote] -pushToRemotes' now notifypushes remotes = do + syncAction remotes' (pushToRemotes' now) +pushToRemotes' :: UTCTime -> [Remote] -> Assistant [Remote] +pushToRemotes' now remotes = do (g, branch, u) <- liftAnnex $ do Annex.Branch.commit "update" (,,) <$> gitRepo <*> join Command.Sync.getCurrBranch <*> getUUID - let (xmppremotes, normalremotes) = partition Remote.isXMPPRemote remotes + let (_xmppremotes, normalremotes) = partition Remote.isXMPPRemote remotes ret <- go True branch g u normalremotes - unless (null xmppremotes) $ do - shas <- liftAnnex $ map fst <$> - inRepo (Git.Ref.matchingWithHEAD - [Annex.Branch.fullname, Git.Ref.headRef]) - forM_ xmppremotes $ \r -> sendNetMessage $ - Pushing (getXMPPClientID r) (CanPush u shas) return ret where go _ (Nothing, _) _ _ _ = return [] -- no branch, so nothing to do @@ -152,11 +132,7 @@ pushToRemotes' now notifypushes remotes = do (succeeded, failed) <- parallelPush g rs (push branch) updatemap succeeded [] if null failed - then do - when notifypushes $ - sendNetMessage $ NotifyPush $ - map Remote.uuid succeeded - return failed + then return [] else if shouldretry then retry currbranch g u failed else fallback branch g u failed @@ -175,9 +151,6 @@ pushToRemotes' now notifypushes remotes = do debug ["fallback pushing to", show rs] (succeeded, failed) <- parallelPush g rs (taggedPush u Nothing branch) updatemap succeeded failed - when (notifypushes && (not $ null succeeded)) $ - sendNetMessage $ NotifyPush $ - map Remote.uuid succeeded return failed push branch remote = Command.Sync.pushBranch remote branch @@ -195,10 +168,6 @@ parallelPush g rs a = do {- Displays an alert while running an action that syncs with some remotes, - and returns any remotes that it failed to sync with. - - - XMPP remotes are handled specially; since the action can only start - - an async process for them, they are not included in the alert, but are - - still passed to the action. - - - Readonly remotes are also hidden (to hide the web special remote). -} syncAction :: [Remote] -> ([Remote] -> Assistant [Remote]) -> Assistant [Remote] @@ -222,15 +191,11 @@ syncAction rs a - remotes that it failed to pull from, and a Bool indicating - whether the git-annex branches of the remotes and local had - diverged before the pull. - - - - After pulling from the normal git remotes, requests pushes from any - - XMPP remotes. However, those pushes will run asynchronously, so their - - results are not included in the return data. -} manualPull :: Command.Sync.CurrBranch -> [Remote] -> Assistant ([Remote], Bool) manualPull currentbranch remotes = do g <- liftAnnex gitRepo - let (xmppremotes, normalremotes) = partition Remote.isXMPPRemote remotes + let (_xmppremotes, normalremotes) = partition Remote.isXMPPRemote remotes failed <- forM normalremotes $ \r -> do g' <- liftAnnex $ sshOptionsTo (Remote.repo r) (Remote.gitconfig r) g ifM (liftIO $ Git.Command.runBool [Param "fetch", Param $ Remote.name r] g') @@ -240,9 +205,6 @@ manualPull currentbranch remotes = do haddiverged <- liftAnnex Annex.Branch.forceUpdate forM_ normalremotes $ \r -> liftAnnex $ Command.Sync.mergeRemote r currentbranch mergeConfig - u <- liftAnnex getUUID - forM_ xmppremotes $ \r -> - sendNetMessage $ Pushing (getXMPPClientID r) (PushRequest u) return (catMaybes failed, haddiverged) mergeConfig :: [Git.Merge.MergeConfig] @@ -257,7 +219,7 @@ syncRemote :: Remote -> Assistant () syncRemote remote = do updateSyncRemotes thread <- asIO $ do - reconnectRemotes False [remote] + reconnectRemotes [remote] addScanRemotes True [remote] void $ liftIO $ forkIO $ thread |