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

@@ -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))

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

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

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)) $

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, _))

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

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

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 <joeyh@debian.org>  Tue, 28 Jan 2014 13:57:19 -0400