tag xmpp pushes with jid
This fixes the issue mentioned in the last commit. Turns out just collecting UUID of clients behind a XMPP remote is insufficient (although I should probably still do it for other reasons), because a single remote repo might be connected via both XMPP and local pairing. So a way is needed to know when a push was received from any client using a given XMPP remote over XMPP, as opposed to via ssh.
This commit is contained in:
parent
c23ea9e311
commit
cbb6e1fae4
7 changed files with 76 additions and 49 deletions
|
@ -48,11 +48,9 @@ reconnectRemotes _ [] = noop
|
|||
reconnectRemotes notifypushes rs = void $ do
|
||||
modifyDaemonStatus_ $ \s -> s
|
||||
{ desynced = S.union (S.fromList $ map Remote.uuid xmppremotes) (desynced s) }
|
||||
alertWhile (syncAlert normalremotes) $ do
|
||||
(ok, diverged) <- sync
|
||||
=<< liftAnnex (inRepo Git.Branch.current)
|
||||
addScanRemotes diverged rs
|
||||
return ok
|
||||
if null normalremotes
|
||||
then go
|
||||
else alertWhile (syncAlert normalremotes) go
|
||||
where
|
||||
gitremotes = filter (notspecialremote . Remote.repo) rs
|
||||
(xmppremotes, normalremotes) = partition isXMPPRemote gitremotes
|
||||
|
@ -69,6 +67,11 @@ reconnectRemotes notifypushes rs = void $ do
|
|||
sync Nothing = do
|
||||
diverged <- snd <$> manualPull Nothing gitremotes
|
||||
return (True, diverged)
|
||||
go = do
|
||||
(ok, diverged) <- sync
|
||||
=<< liftAnnex (inRepo Git.Branch.current)
|
||||
addScanRemotes diverged rs
|
||||
return ok
|
||||
|
||||
{- Updates the local sync branch, then pushes it to all remotes, in
|
||||
- parallel, along with the git-annex branch. This is the same
|
||||
|
@ -137,7 +140,7 @@ pushToRemotes now notifypushes remotes = do
|
|||
fallback branch g u rs = do
|
||||
debug ["fallback pushing to", show rs]
|
||||
(succeeded, failed) <- liftIO $
|
||||
inParallel (\r -> taggedPush u branch r g) rs
|
||||
inParallel (\r -> taggedPush u Nothing branch r g) rs
|
||||
updatemap succeeded failed
|
||||
when (notifypushes && (not $ null succeeded)) $
|
||||
sendNetMessage $ NotifyPush $
|
||||
|
|
|
@ -22,6 +22,7 @@ import Annex.TaggedPush
|
|||
import Remote (remoteFromUUID)
|
||||
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.Text as T
|
||||
|
||||
{- This thread watches for changes to .git/refs/, and handles incoming
|
||||
- pushes. -}
|
||||
|
@ -89,21 +90,21 @@ onAdd file
|
|||
void $ liftAnnex $ Command.Sync.mergeFrom changedbranch
|
||||
mergecurrent _ = noop
|
||||
|
||||
handleDesynced = case branchTaggedBy changedbranch of
|
||||
handleDesynced = case fromTaggedBranch changedbranch of
|
||||
Nothing -> return False
|
||||
Just u -> do
|
||||
s <- desynced <$> getDaemonStatus
|
||||
if S.member u s
|
||||
then do
|
||||
modifyDaemonStatus_ $ \st -> st
|
||||
{ desynced = S.delete u s }
|
||||
mr <- liftAnnex $ remoteFromUUID u
|
||||
case mr of
|
||||
Just r -> do
|
||||
Just (u, info) -> do
|
||||
mr <- liftAnnex $ remoteFromUUID u
|
||||
case mr of
|
||||
Nothing -> return False
|
||||
Just r -> do
|
||||
s <- desynced <$> getDaemonStatus
|
||||
if S.member u s || Just (T.unpack $ getXMPPClientID r) == info
|
||||
then do
|
||||
modifyDaemonStatus_ $ \st -> st
|
||||
{ desynced = S.delete u s }
|
||||
addScanRemotes True [r]
|
||||
return True
|
||||
Nothing -> return False
|
||||
else return False
|
||||
else return False
|
||||
|
||||
equivBranches :: Git.Ref -> Git.Ref -> Bool
|
||||
equivBranches x y = base x == base y
|
||||
|
|
|
@ -38,18 +38,20 @@ xmppClientThread urlrenderer = namedThread "XMPPClient" $
|
|||
restartableClient . xmppClient urlrenderer =<< getAssistant id
|
||||
|
||||
{- Runs the client, handing restart events. -}
|
||||
restartableClient :: IO () -> Assistant ()
|
||||
restartableClient a = forever $ do
|
||||
tid <- liftIO $ forkIO a
|
||||
waitNetMessagerRestart
|
||||
liftIO $ killThread tid
|
||||
restartableClient :: (XMPPCreds -> IO ()) -> Assistant ()
|
||||
restartableClient a = forever $ go =<< liftAnnex getXMPPCreds
|
||||
where
|
||||
go Nothing = waitNetMessagerRestart
|
||||
go (Just creds) = do
|
||||
modifyDaemonStatus_ $ \s -> s
|
||||
{ xmppClientID = Just $ xmppJID creds }
|
||||
tid <- liftIO $ forkIO $ a creds
|
||||
waitNetMessagerRestart
|
||||
liftIO $ killThread tid
|
||||
|
||||
xmppClient :: UrlRenderer -> AssistantData -> IO ()
|
||||
xmppClient urlrenderer d = do
|
||||
v <- liftAssistant $ liftAnnex getXMPPCreds
|
||||
case v of
|
||||
Nothing -> noop -- will be restarted once creds get configured
|
||||
Just c -> retry (runclient c) =<< getCurrentTime
|
||||
xmppClient :: UrlRenderer -> AssistantData -> XMPPCreds -> IO ()
|
||||
xmppClient urlrenderer d creds =
|
||||
retry (runclient creds) =<< getCurrentTime
|
||||
where
|
||||
liftAssistant = runAssistant d
|
||||
inAssistant = liftIO . liftAssistant
|
||||
|
|
|
@ -15,6 +15,7 @@ import Assistant.Pairing
|
|||
import Utility.NotificationBroadcaster
|
||||
import Logs.Transfer
|
||||
import Assistant.Types.ThreadName
|
||||
import Assistant.Types.NetMessager
|
||||
|
||||
import Control.Concurrent.STM
|
||||
import Control.Concurrent.Async
|
||||
|
@ -57,6 +58,8 @@ data DaemonStatus = DaemonStatus
|
|||
, alertNotifier :: NotificationBroadcaster
|
||||
-- Broadcasts notifications when the syncRemotes change
|
||||
, syncRemotesNotifier :: NotificationBroadcaster
|
||||
-- When the XMPP client is in use, this will contain its JI.
|
||||
, xmppClientID :: Maybe ClientID
|
||||
}
|
||||
|
||||
type TransferMap = M.Map Transfer TransferInfo
|
||||
|
@ -83,3 +86,4 @@ newDaemonStatus = DaemonStatus
|
|||
<*> newNotificationBroadcaster
|
||||
<*> newNotificationBroadcaster
|
||||
<*> newNotificationBroadcaster
|
||||
<*> pure Nothing
|
||||
|
|
|
@ -264,7 +264,8 @@ handlePushInitiation (Pushing cid PushRequest) =
|
|||
<*> getUUID
|
||||
liftIO $ Command.Sync.updateBranch (Command.Sync.syncBranch branch) g
|
||||
debug ["pushing to", show rs]
|
||||
forM_ rs $ \r -> xmppPush cid $ taggedPush u branch r
|
||||
selfjid <- ((T.unpack <$>) . xmppClientID) <$> getDaemonStatus
|
||||
forM_ rs $ \r -> xmppPush cid $ taggedPush u selfjid branch r
|
||||
handlePushInitiation (Pushing cid StartingPush) =
|
||||
whenXMPPRemote cid $
|
||||
void $ xmppReceivePack cid
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue