summaryrefslogtreecommitdiff
path: root/Assistant/Sync.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Assistant/Sync.hs')
-rw-r--r--Assistant/Sync.hs18
1 files changed, 16 insertions, 2 deletions
diff --git a/Assistant/Sync.hs b/Assistant/Sync.hs
index 9eaad5469..97fcc88ce 100644
--- a/Assistant/Sync.hs
+++ b/Assistant/Sync.hs
@@ -27,6 +27,7 @@ import Annex.UUID
import Data.Time.Clock
import qualified Data.Map as M
+import qualified Data.Text as T
import Control.Concurrent
{- Syncs with remotes that may have been disconnected for a while.
@@ -66,7 +67,8 @@ 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 handles pushes over XMPP.
+ - 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.
@@ -95,7 +97,10 @@ pushToRemotes now notifypushes remotes = do
<$> gitRepo
<*> inRepo Git.Branch.current
<*> getUUID
- go True branch g u remotes
+ let (xmppremotes, normalremotes) = partition isXMPPRemote remotes
+ r <- go True branch g u normalremotes
+ mapM_ (sendNetMessage . CanPush . getXMPPClientID) xmppremotes
+ return r
where
go _ Nothing _ _ _ = return True -- no branch, so nothing to do
go shouldretry (Just branch) g u rs = do
@@ -167,3 +172,12 @@ syncNewRemote remote = do
thread <- asIO $ do
reconnectRemotes False [remote]
void $ liftIO $ forkIO $ thread
+
+{- 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))