From 2d8cbcafa66a317fcb3d571cd8bf45962d651998 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Wed, 5 Apr 2017 13:04:02 -0400
Subject: Added remote.<name>.annex-push and remote.<name>.annex-pull

The former can be useful to make remotes that don't get fully synced with
local changes, which comes up in a lot of situations.

The latter was mostly added for symmetry, but could be useful (though less
likely to be).

Implementing `remote.<name>.annex-pull` was a bit tricky, as there's no one
place where git-annex pulls/fetches from remotes. I audited all
instances of "fetch" and "pull". A few cases were left not checking this
config:

* Git.Repair can try to pull missing refs from a remote, and if the local
  repo is corrupted, that seems a reasonable thing to do even though
  the config would normally prevent it.
* Assistant.WebApp.Gpg and Remote.Gcrypt and Remote.Git do fetches
  as part of the setup process of a remote. The config would probably not
  be set then, and having the setup fail seems worse than honoring it if it
  is already set.

I have not prevented all the code that does a "merge" from merging branches
from remotes with remote.<name>.annex-pull=false. That could perhaps
be done, but it would need a way to map from branch name to remote name,
and the way refspecs work makes that hard to get really correct. So if the
user fetches manually, the git-annex branch will get merged, for example.
Anther way of looking at/justifying this is that the setting is called
"annex-pull", not "annex-merge".

This commit was supported by the NSF-funded DataLad project.
---
 Assistant/Sync.hs | 24 +++++++++++++++++-------
 1 file changed, 17 insertions(+), 7 deletions(-)

(limited to 'Assistant')

diff --git a/Assistant/Sync.hs b/Assistant/Sync.hs
index 702f1e98f..8f30aa4f7 100644
--- a/Assistant/Sync.hs
+++ b/Assistant/Sync.hs
@@ -110,8 +110,14 @@ reconnectRemotes rs = void $ do
 pushToRemotes :: [Remote] -> Assistant [Remote]
 pushToRemotes remotes = do
 	now <- liftIO getCurrentTime
-	let remotes' = filter (not . remoteAnnexReadOnly . Remote.gitconfig) remotes
+	let remotes' = filter (wantpush . Remote.gitconfig) remotes
 	syncAction remotes' (pushToRemotes' now)
+  where
+	wantpush gc
+		| remoteAnnexReadOnly gc = False
+		| not (remoteAnnexPush gc) = False
+		| otherwise = True
+
 pushToRemotes' :: UTCTime -> [Remote] -> Assistant [Remote]
 pushToRemotes' now remotes = do
 	(g, branch, u) <- liftAnnex $ do
@@ -195,16 +201,20 @@ manualPull :: Command.Sync.CurrBranch -> [Remote] -> Assistant ([Remote], Bool)
 manualPull currentbranch remotes = do
 	g <- liftAnnex gitRepo
 	let (_xmppremotes, normalremotes) = partition Remote.isXMPPRemote remotes
-	failed <- forM normalremotes $ \r -> do
-		g' <- liftAnnex $ sshOptionsTo (Remote.repo r) (Remote.gitconfig r) g
-		ifM (liftIO $ Git.Command.runBool [Param "fetch", Param $ Remote.name r] g')
-			( return Nothing
-			, return $ Just r
-			)
+	failed <- forM normalremotes $ \r -> if wantpull $ Remote.gitconfig r
+		then do
+			g' <- liftAnnex $ sshOptionsTo (Remote.repo r) (Remote.gitconfig r) g
+			ifM (liftIO $ Git.Command.runBool [Param "fetch", Param $ Remote.name r] g')
+				( return Nothing
+				, return $ Just r
+				)
+		else return Nothing
 	haddiverged <- liftAnnex Annex.Branch.forceUpdate
 	forM_ normalremotes $ \r ->
 		liftAnnex $ Command.Sync.mergeRemote r currentbranch Command.Sync.mergeConfig
 	return (catMaybes failed, haddiverged)
+  where
+	wantpull gc = remoteAnnexPull gc
 
 {- Start syncing a remote, using a background thread. -}
 syncRemote :: Remote -> Assistant ()
-- 
cgit v1.2.3