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.
This commit is contained in:
parent
8bbe4ff934
commit
bbef0cddfd
8 changed files with 23 additions and 16 deletions
|
@ -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))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)) $
|
||||
|
|
|
@ -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, _))
|
||||
|
|
|
@ -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
|
||||
|
|
10
Remote.hs
10
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
|
||||
|
|
3
debian/changelog
vendored
3
debian/changelog
vendored
|
@ -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 <joeyh@debian.org> Tue, 28 Jan 2014 13:57:19 -0400
|
||||
|
||||
|
|
Loading…
Reference in a new issue