assistant: Deal with upcoming git's refusal to merge unrelated histories by default

git 2.8.1 (or perhaps 2.9.0) is going to prevent git merge from merging in
unrelated branches. Since the webapp's pairing etc features often combine
together repositories with unrelated histories, work around this behavior
change by setting GIT_MERGE_ALLOW_UNRELATED_HISTORIES when the assistant
merges.

Note though that this is not done for git annex sync's merges, so
it will follow git's default or configured behavior.

Annex/AdjustedBranch.hs

@@ -260,8 +260,8 @@ adjustedBranchCommitMessage = "git-annex adjusted branch"
 {- Update the currently checked out adjusted branch, merging the provided
  - branch into it. Note that the provided branch should be a non-adjusted
  - branch. -}
-updateAdjustedBranch :: Branch -> (OrigBranch, Adjustment) -> Git.Branch.CommitMode -> Annex Bool
+updateAdjustedBranch :: Branch -> (OrigBranch, Adjustment) -> [Git.Merge.MergeConfig] -> Git.Branch.CommitMode -> Annex Bool
-updateAdjustedBranch tomerge (origbranch, adj) commitmode = catchBoolIO $
+updateAdjustedBranch tomerge (origbranch, adj) mergeconfig commitmode = catchBoolIO $
 	join $ preventCommits go
   where
 	adjbranch@(AdjBranch currbranch) = originalToAdjusted origbranch adj
@@ -304,7 +304,7 @@ updateAdjustedBranch tomerge (origbranch, adj) commitmode = catchBoolIO $
 				showAction $ "Merging into " ++ fromRef (Git.Ref.base origbranch)
 				-- The --no-ff is important; it makes git
 				-- merge not care that the work tree is empty.
-				merged <- inRepo (Git.Merge.mergeNonInteractive' [Param "--no-ff"] tomerge commitmode)
+				merged <- inRepo (Git.Merge.merge' [Param "--no-ff"] tomerge mergeconfig commitmode)
 					<||> (resolveMerge (Just updatedorig) tomerge True <&&> commitResolvedMerge commitmode)
 				if merged
 					then do
@@ -340,7 +340,7 @@ updateAdjustedBranch tomerge (origbranch, adj) commitmode = catchBoolIO $
 		-- this commit will be a fast-forward.
 		adjmergecommitff <- commitAdjustedTree' adjtree (BasisBranch mergecommit) [currbranch]
 		showAction "Merging into adjusted branch"
-		ifM (autoMergeFrom adjmergecommitff (Just currbranch) commitmode)
+		ifM (autoMergeFrom adjmergecommitff (Just currbranch) mergeconfig commitmode)
 			( reparent adjtree adjmergecommit =<< getcurrentcommit
 			, return False
 			)

Annex/AutoMerge.hs

@@ -43,16 +43,16 @@ import qualified Data.ByteString.Lazy as L
  - Callers should use Git.Branch.changed first, to make sure that
  - there are changes from the current branch to the branch being merged in.
  -}
-autoMergeFrom :: Git.Ref -> Maybe Git.Ref -> Git.Branch.CommitMode -> Annex Bool
+autoMergeFrom :: Git.Ref -> Maybe Git.Ref -> [Git.Merge.MergeConfig] -> Git.Branch.CommitMode -> Annex Bool
-autoMergeFrom branch currbranch commitmode = do
+autoMergeFrom branch currbranch mergeconfig commitmode = do
 	showOutput
 	case currbranch of
 		Nothing -> go Nothing
 		Just b -> go =<< inRepo (Git.Ref.sha b)
   where
 	go old = ifM isDirect
-		( mergeDirect currbranch old branch (resolveMerge old branch False) commitmode
+		( mergeDirect currbranch old branch (resolveMerge old branch False) mergeconfig commitmode
-		, inRepo (Git.Merge.mergeNonInteractive branch commitmode)
+		, inRepo (Git.Merge.merge branch mergeconfig commitmode)
 			<||> (resolveMerge old branch False <&&> commitResolvedMerge commitmode)
 		)
 

Annex/Direct.hs

@@ -162,8 +162,8 @@ addDirect file cache = do
  - file. This is the same as what git does when updating the index
  - normally.
  -}
-mergeDirect :: Maybe Git.Ref -> Maybe Git.Ref -> Git.Branch -> Annex Bool -> Git.Branch.CommitMode -> Annex Bool
+mergeDirect :: Maybe Git.Ref -> Maybe Git.Ref -> Git.Branch -> Annex Bool -> [Git.Merge.MergeConfig] -> Git.Branch.CommitMode -> Annex Bool
-mergeDirect startbranch oldref branch resolvemerge commitmode = exclusively $ do
+mergeDirect startbranch oldref branch resolvemerge mergeconfig commitmode = exclusively $ do
 	reali <- liftIO . absPath =<< fromRepo indexFile
 	tmpi <- liftIO . absPath =<< fromRepo indexFileLock
 	liftIO $ whenM (doesFileExist reali) $
@@ -176,7 +176,7 @@ mergeDirect startbranch oldref branch resolvemerge commitmode = exclusively $ do
 		createDirectoryIfMissing True d
 
 	withIndexFile tmpi $ do
-		merged <- stageMerge d branch commitmode
+		merged <- stageMerge d branch mergeconfig commitmode
 		ok <- if merged
 			then return True
 			else resolvemerge
@@ -195,19 +195,18 @@ mergeDirect startbranch oldref branch resolvemerge commitmode = exclusively $ do
 
 {- Stage a merge into the index, avoiding changing HEAD or the current
  - branch. -}
-stageMerge :: FilePath -> Git.Branch -> Git.Branch.CommitMode -> Annex Bool
+stageMerge :: FilePath -> Git.Branch -> [Git.Merge.MergeConfig] -> Git.Branch.CommitMode -> Annex Bool
-stageMerge d branch commitmode = do
+stageMerge d branch mergeconfig commitmode = do
 	-- XXX A bug in git makes stageMerge unsafe to use if the git repo
 	-- is configured with core.symlinks=false
-	-- Using mergeNonInteractive is not ideal though, since it will
+	-- Using merge is not ideal though, since it will
 	-- update the current branch immediately, before the work tree
 	-- has been updated, which would leave things in an inconsistent
 	-- state if mergeDirectCleanup is interrupted.
 	-- <http://marc.info/?l=git&m=140262402204212&w=2>
-	liftIO $ print ("stagemerge in", d)
 	merger <- ifM (coreSymlinks <$> Annex.getGitConfig)
-		( return Git.Merge.stageMerge
+		( return $ \ref -> Git.Merge.stageMerge ref mergeconfig
-		, return $ \ref -> Git.Merge.mergeNonInteractive ref commitmode
+		, return $ \ref -> Git.Merge.merge ref mergeconfig commitmode
 		)
 	inRepo $ \g -> do
 		wd <- liftIO $ absPath d

Assistant/Sync.hs

@@ -21,6 +21,7 @@ import Utility.Parallel
 import qualified Git
 import qualified Git.Command
 import qualified Git.Ref
+import qualified Git.Merge
 import qualified Remote
 import qualified Types.Remote as Remote
 import qualified Remote.List as Remote
@@ -238,12 +239,19 @@ manualPull currentbranch remotes = do
 			)
 	haddiverged <- liftAnnex Annex.Branch.forceUpdate
 	forM_ normalremotes $ \r ->
-		liftAnnex $ Command.Sync.mergeRemote r currentbranch
+		liftAnnex $ Command.Sync.mergeRemote r currentbranch mergeConfig
 	u <- liftAnnex getUUID
 	forM_ xmppremotes $ \r ->
 		sendNetMessage $ Pushing (getXMPPClientID r) (PushRequest u)
 	return (catMaybes failed, haddiverged)
 
+mergeConfig :: [Git.Merge.MergeConfig]
+mergeConfig = 
+	[ Git.Merge.MergeNonInteractive
+	-- Pairing involves merging unrelated histories
+	, Git.Merge.MergeUnrelatedHistories
+	]
+
 {- Start syncing a remote, using a background thread. -}
 syncRemote :: Remote -> Assistant ()
 syncRemote remote = do

Assistant/Threads/Merger.hs

@@ -12,6 +12,7 @@ import Assistant.TransferQueue
 import Assistant.BranchChange
 import Assistant.DaemonStatus
 import Assistant.ScanRemotes
+import Assistant.Sync
 import Utility.DirWatcher
 import Utility.DirWatcher.Types
 import qualified Annex.Branch
@@ -85,7 +86,8 @@ onChange file
 					, "into", Git.fromRef b
 					]
 				void $ liftAnnex $ Command.Sync.merge
-					currbranch Git.Branch.AutomaticCommit
+					currbranch mergeConfig
+					Git.Branch.AutomaticCommit
 					changedbranch
 	mergecurrent _ = noop
 

Command/Sync.hs

@@ -32,6 +32,7 @@ import Annex.Hook
 import qualified Git.Command
 import qualified Git.LsFiles as LsFiles
 import qualified Git.Branch
+import qualified Git.Merge
 import qualified Git.Types as Git
 import qualified Git.Ref
 import qualified Git
@@ -112,7 +113,7 @@ seek o = allowConcurrentOutput $ do
 	mapM_ includeCommandAction $ concat
 		[ [ commit o ]
 		, [ withbranch mergeLocal ]
-		, map (withbranch . pullRemote o) gitremotes
+		, map (withbranch . pullRemote o mergeconfig) gitremotes
 		,  [ mergeAnnex ]
 		]
 	when (contentOption o) $
@@ -123,13 +124,15 @@ seek o = allowConcurrentOutput $ do
 			-- and merge again to avoid our push overwriting
 			-- those changes.
 			mapM_ includeCommandAction $ concat
-				[ map (withbranch . pullRemote o) gitremotes
+				[ map (withbranch . pullRemote o mergeconfig) gitremotes
 				, [ commitAnnex, mergeAnnex ]
 				]
 	
 	void $ includeCommandAction $ withbranch pushLocal
 	-- Pushes to remotes can run concurrently.
 	mapM_ (commandAction . withbranch . pushRemote o) gitremotes
+  where
+	mergeconfig = [Git.Merge.MergeNonInteractive]
 
 type CurrBranch = (Maybe Git.Branch, Maybe Adjustment)
 
@@ -166,11 +169,11 @@ getCurrBranch = do
 prepMerge :: Annex ()
 prepMerge = Annex.changeDirectory =<< fromRepo Git.repoPath
 
-merge :: CurrBranch -> Git.Branch.CommitMode -> Git.Branch -> Annex Bool
+merge :: CurrBranch -> [Git.Merge.MergeConfig] -> Git.Branch.CommitMode -> Git.Branch -> Annex Bool
-merge (Just b, Just adj) commitmode tomerge =
+merge (Just b, Just adj) mergeconfig commitmode tomerge =
-	updateAdjustedBranch tomerge (b, adj) commitmode
+	updateAdjustedBranch tomerge (b, adj) mergeconfig commitmode
-merge (b, _) commitmode tomerge =
+merge (b, _) mergeconfig commitmode tomerge =
-	autoMergeFrom tomerge b commitmode
+	autoMergeFrom tomerge b mergeconfig commitmode
 
 syncBranch :: Git.Branch -> Git.Branch
 syncBranch = Git.Ref.under "refs/heads/synced" . fromDirectBranch . fromAdjustedBranch
@@ -257,7 +260,7 @@ mergeLocal currbranch@(Just branch, madj) = go =<< needmerge
 	go False = stop
 	go True = do
 		showStart "merge" $ Git.Ref.describe syncbranch
-		next $ next $ merge currbranch Git.Branch.ManualCommit syncbranch
+		next $ next $ merge currbranch [Git.Merge.MergeNonInteractive] Git.Branch.ManualCommit syncbranch
 	branch' = maybe branch (adjBranch . originalToAdjusted branch) madj
 mergeLocal (Nothing, _) = stop
 
@@ -291,13 +294,13 @@ updateBranch syncbranch updateto g =
 		, Param $ Git.fromRef $ updateto
 		] g
 
-pullRemote :: SyncOptions -> Remote -> CurrBranch -> CommandStart
+pullRemote :: SyncOptions -> [Git.Merge.MergeConfig] -> Remote -> CurrBranch -> CommandStart
-pullRemote o remote branch = stopUnless (pure $ pullOption o) $ do
+pullRemote o mergeconfig remote branch = stopUnless (pure $ pullOption o) $ do
 	showStart "pull" (Remote.name remote)
 	next $ do
 		showOutput
 		stopUnless fetch $
-			next $ mergeRemote remote branch
+			next $ mergeRemote remote branch mergeconfig
   where
 	fetch = inRepoWithSshOptionsTo (Remote.repo remote) (Remote.gitconfig remote) $
 		Git.Command.runBool
@@ -308,8 +311,8 @@ pullRemote o remote branch = stopUnless (pure $ pullOption o) $ do
  - were committed (or pushed changes, if this is a bare remote),
  - while the synced/master may have changes that some
  - other remote synced to this remote. So, merge them both. -}
-mergeRemote :: Remote -> CurrBranch -> CommandCleanup
+mergeRemote :: Remote -> CurrBranch -> [Git.Merge.MergeConfig] -> CommandCleanup
-mergeRemote remote currbranch = ifM isBareRepo
+mergeRemote remote currbranch mergeconfig = ifM isBareRepo
 	( return True
 	, case currbranch of
 		(Nothing, _) -> do
@@ -321,7 +324,7 @@ mergeRemote remote currbranch = ifM isBareRepo
 	)
   where
 	mergelisted getlist = and <$> 
-		(mapM (merge currbranch Git.Branch.ManualCommit . remoteBranch remote) =<< getlist)
+		(mapM (merge currbranch mergeconfig Git.Branch.ManualCommit . remoteBranch remote) =<< getlist)
 	tomerge = filterM (changed remote)
 	branchlist Nothing = []
 	branchlist (Just branch) = [branch, syncBranch branch]

Git/Merge.hs

@@ -1,36 +1,51 @@
 {- git merging
  -
- - Copyright 2012, 2014 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2016 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Git.Merge where
+module Git.Merge (
+	MergeConfig(..),
+	CommitMode(..),
+	merge,
+	merge',
+	stageMerge,
+) where
 
 import Common
 import Git
 import Git.Command
 import Git.BuildVersion
 import Git.Branch (CommitMode(..))
+import Git.Env
 
-{- Avoids recent git's interactive merge. -}
+data MergeConfig
-mergeNonInteractive :: Ref -> CommitMode -> Repo -> IO Bool
+	= MergeNonInteractive
-mergeNonInteractive = mergeNonInteractive' []
+	-- ^ avoids recent git's interactive merge
+	| MergeUnrelatedHistories
+	-- ^ avoids recent git's prevention of merging unrelated histories
+	deriving (Eq)
 
-mergeNonInteractive' :: [CommandParam] -> Ref -> CommitMode -> Repo -> IO Bool
+merge :: Ref -> [MergeConfig] -> CommitMode -> Repo -> IO Bool
-mergeNonInteractive' extraparams branch commitmode
+merge = merge' []
-	| older "1.7.7.6" = merge [Param $ fromRef branch]
+
-	| otherwise = merge $ [Param "--no-edit", Param $ fromRef branch]
+merge' :: [CommandParam] -> Ref -> [MergeConfig] -> CommitMode -> Repo -> IO Bool
+merge' extraparams branch mergeconfig commitmode r
+	| MergeNonInteractive `notElem` mergeconfig || older "1.7.7.6" =
+		go [Param $ fromRef branch]
+	| otherwise = go [Param "--no-edit", Param $ fromRef branch]
   where
-	merge ps = runBool $ sp ++ [Param "merge"] ++ ps ++ extraparams
+	go ps = runBool (sp ++ [Param "merge"] ++ ps ++ extraparams)
+		=<< cfgRepo mergeconfig r
 	sp
 		| commitmode == AutomaticCommit =
 			[Param "-c", Param "commit.gpgsign=false"]
 		| otherwise = []
 
 {- Stage the merge into the index, but do not commit it.-}
-stageMerge :: Ref -> Repo -> IO Bool
+stageMerge :: Ref -> [MergeConfig] -> Repo -> IO Bool
-stageMerge branch = runBool
+stageMerge branch mergeconfig r = runBool
 	[ Param "merge"
 	, Param "--quiet"
 	, Param "--no-commit"
@@ -38,4 +53,10 @@ stageMerge branch = runBool
 	-- commit.
 	, Param "--no-ff"
 	, Param $ fromRef branch
-	]
+	] =<< cfgRepo mergeconfig r
+
+cfgRepo :: [MergeConfig] -> Repo -> IO Repo
+cfgRepo mergeconfig r
+	| MergeUnrelatedHistories `elem` mergeconfig =
+		addGitEnv r "GIT_MERGE_ALLOW_UNRELATED_HISTORIES" "1"
+	| otherwise = return r

debian/changelog

@@ -16,6 +16,13 @@ git-annex (6.20160419) UNRELEASED; urgency=medium
   * When git-annex is used with a git version older than 2.2.0, disable
     support for adjusted branches, since GIT_COMMON_DIR is needed to update
     them and was first added in that version of git.
+  * git 2.8.1 (or perhaps 2.9.0) is going to prevent git merge from
+    merging in unrelated branches. Since the webapp's pairing etc features
+    often combine together repositories with unrelated histories, work around
+    this behavior change by setting GIT_MERGE_ALLOW_UNRELATED_HISTORIES
+    when the assistant merges. Note though that this is not done for
+    git annex sync's merges, so it will follow git's default or configured
+    behavior.
 
  -- Joey Hess <id@joeyh.name>  Tue, 19 Apr 2016 12:57:15 -0400
 

doc/todo/support_--allow-unrelated-histories_in_git_2.8.1pre.mdwn

@@ -13,3 +13,7 @@ be split into a fetch and a merge in order to pass the option to the merge;
 but AFAICS, git-annex never uses `git pull`)
 
 --[[Joey]]
+
+> [[done]]; used the environment variable
+> `GIT_MERGE_ALLOW_UNRELATED_HISTORIES` which will hopefully land in git
+> `next` (currently in `pu`) --[[Joey]]