From bbef0cddfdc0db8fd19decb0eb9fb7b495d54e8a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 1 Feb 2014 10:33:55 -0400 Subject: [PATCH] improve sync with xmpp and annex-ignore * sync --content: Honor annex-ignore configuration. * sync: Don't try to sync with xmpp remotes, which are only currently supported when using the assistant. --- Assistant/DaemonStatus.hs | 8 +------- Assistant/Sync.hs | 8 ++++---- Assistant/Threads/XMPPClient.hs | 2 +- Assistant/WebApp/Configurators/XMPP.hs | 2 +- Assistant/WebApp/RepoList.hs | 2 +- Command/Sync.hs | 4 +++- Remote.hs | 10 +++++++++- debian/changelog | 3 +++ 8 files changed, 23 insertions(+), 16 deletions(-) diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs index e38463ff66..eb842b7847 100644 --- a/Assistant/DaemonStatus.hs +++ b/Assistant/DaemonStatus.hs @@ -55,7 +55,7 @@ calcSyncRemotes = do let good r = Remote.uuid r `elem` alive let syncable = filter good rs let syncdata = filter (not . remoteAnnexIgnore . Remote.gitconfig) $ - filter (not . isXMPPRemote) syncable + filter (not . Remote.isXMPPRemote) syncable return $ \dstatus -> dstatus { syncRemotes = syncable @@ -257,11 +257,5 @@ 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)) diff --git a/Assistant/Sync.hs b/Assistant/Sync.hs index adbe413508..fc95419ab8 100644 --- a/Assistant/Sync.hs +++ b/Assistant/Sync.hs @@ -71,7 +71,7 @@ reconnectRemotes notifypushes rs = void $ do mapM_ signal $ filter (`notElem` failedrs) rs' where gitremotes = filter (notspecialremote . Remote.repo) rs - (xmppremotes, nonxmppremotes) = partition isXMPPRemote rs + (xmppremotes, nonxmppremotes) = partition Remote.isXMPPRemote rs notspecialremote r | Git.repoIsUrl r = True | Git.repoIsLocal r = True @@ -133,7 +133,7 @@ pushToRemotes' now notifypushes remotes = do <$> gitRepo <*> inRepo Git.Branch.current <*> getUUID - let (xmppremotes, normalremotes) = partition isXMPPRemote remotes + let (xmppremotes, normalremotes) = partition Remote.isXMPPRemote remotes ret <- go True branch g u normalremotes unless (null xmppremotes) $ do shas <- liftAnnex $ map fst <$> @@ -206,7 +206,7 @@ syncAction rs a return failed where visibleremotes = filter (not . Remote.readonly) $ - filter (not . isXMPPRemote) rs + filter (not . Remote.isXMPPRemote) rs {- Manually pull from remotes and merge their branches. Returns any - remotes that it failed to pull from, and a Bool indicating @@ -220,7 +220,7 @@ syncAction rs a manualPull :: Maybe Git.Ref -> [Remote] -> Assistant ([Remote], Bool) manualPull currentbranch remotes = do g <- liftAnnex gitRepo - let (xmppremotes, normalremotes) = partition isXMPPRemote remotes + let (xmppremotes, normalremotes) = partition Remote.isXMPPRemote remotes failed <- liftIO $ forM normalremotes $ \r -> ifM (Git.Command.runBool [Param "fetch", Param $ Remote.name r] g) ( return Nothing diff --git a/Assistant/Threads/XMPPClient.hs b/Assistant/Threads/XMPPClient.hs index 8eb4699390..ab4de9257f 100644 --- a/Assistant/Threads/XMPPClient.hs +++ b/Assistant/Threads/XMPPClient.hs @@ -322,7 +322,7 @@ pairMsgReceived urlrenderer PairReq theiruuid selfjid theirjid | baseJID selfjid == baseJID theirjid = autoaccept | otherwise = do knownjids <- mapMaybe (parseJID . getXMPPClientID) - . filter isXMPPRemote . syncRemotes <$> getDaemonStatus + . filter Remote.isXMPPRemote . syncRemotes <$> getDaemonStatus um <- liftAnnex uuidMap if elem (baseJID theirjid) knownjids && M.member theiruuid um then autoaccept diff --git a/Assistant/WebApp/Configurators/XMPP.hs b/Assistant/WebApp/Configurators/XMPP.hs index d0ded0b228..e7ba6c0736 100644 --- a/Assistant/WebApp/Configurators/XMPP.hs +++ b/Assistant/WebApp/Configurators/XMPP.hs @@ -161,7 +161,7 @@ buddyListDisplay = do #ifdef WITH_XMPP getXMPPRemotes :: Assistant [(JID, Remote)] -getXMPPRemotes = catMaybes . map pair . filter isXMPPRemote . syncGitRemotes +getXMPPRemotes = catMaybes . map pair . filter Remote.isXMPPRemote . syncGitRemotes <$> getDaemonStatus where pair r = maybe Nothing (\jid -> Just (jid, r)) $ diff --git a/Assistant/WebApp/RepoList.hs b/Assistant/WebApp/RepoList.hs index fd341466aa..56a3b9ea43 100644 --- a/Assistant/WebApp/RepoList.hs +++ b/Assistant/WebApp/RepoList.hs @@ -164,7 +164,7 @@ repoList reposelector | Remote.readonly r = False | onlyCloud reposelector = Git.repoIsUrl (Remote.repo r) && Remote.uuid r /= NoUUID - && not (isXMPPRemote r) + && not (Remote.isXMPPRemote r) | otherwise = True selectedremote Nothing = False selectedremote (Just (iscloud, _)) diff --git a/Command/Sync.hs b/Command/Sync.hs index acd487df34..5719f5b702 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -75,6 +75,7 @@ seek rs = do remotes <- syncRemotes rs let gitremotes = filter Remote.gitSyncableRemote remotes + let dataremotes = filter (not . remoteAnnexIgnore . Remote.gitconfig) remotes -- Syncing involves many actions, any of which can independently -- fail, without preventing the others from running. @@ -85,7 +86,7 @@ seek rs = do , [ mergeAnnex ] ] whenM (Annex.getFlag $ optionName contentOption) $ - seekSyncContent remotes + seekSyncContent dataremotes seekActions $ return $ concat [ [ withbranch pushLocal ] , map (withbranch . pushRemote) gitremotes @@ -112,6 +113,7 @@ syncRemotes rs = ifM (Annex.getState Annex.fast) ( nub <$> pickfast , wanted ) | otherwise = listed listed = catMaybes <$> mapM (Remote.byName . Just) rs available = filter (remoteAnnexSync . Types.Remote.gitconfig) + . filter (not . Remote.isXMPPRemote) <$> Remote.remoteList good r | Remote.gitSyncableRemote r = Remote.Git.repoAvail $ Types.Remote.repo r diff --git a/Remote.hs b/Remote.hs index 3c838a6230..f2af025fb3 100644 --- a/Remote.hs +++ b/Remote.hs @@ -41,7 +41,8 @@ module Remote ( showLocations, forceTrust, logStatus, - checkAvailable + checkAvailable, + isXMPPRemote ) where import qualified Data.Map as M @@ -60,6 +61,7 @@ import Logs.Location hiding (logStatus) import Remote.List import Config import Git.Types (RemoteName) +import qualified Git {- Map from UUIDs of Remotes to a calculated value. -} remoteMap :: (Remote -> a) -> Annex (M.Map UUID a) @@ -292,3 +294,9 @@ byCost = map snd . sortBy (comparing fst) . M.toList . costmap checkAvailable :: Bool -> Remote -> IO Bool checkAvailable assumenetworkavailable = maybe (return assumenetworkavailable) doesDirectoryExist . localpath + +{- 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 = repo remote diff --git a/debian/changelog b/debian/changelog index 457e79a0ae..de5229ddb6 100644 --- a/debian/changelog +++ b/debian/changelog @@ -6,6 +6,9 @@ git-annex (5.20140128) UNRELEASED; urgency=medium guard against recursive file drops. * Windows: Avoid using unix-compat's rename, which refuses to rename directories. + * sync --content: Honor annex-ignore configuration. + * sync: Don't try to sync with xmpp remotes, which are only currently + supported when using the assistant. -- Joey Hess Tue, 28 Jan 2014 13:57:19 -0400