From: Joey Hess <joeyh@joeyh.name>
Date: Mon, 27 Dec 2021 18:30:51 +0000 (-0400)
Subject: handle overBranchFileContents with read-only unmerged git-annex branches
X-Git-Tag: archive/raspbian/10.20250416-2+rpi1~2^2^2~53^2~428
X-Git-Url: https://dgit.raspbian.org/?a=commitdiff_plain;h=7f6b2ca49cd6f6b6dd6cc9e96d0232a213a82e63;p=git-annex.git

handle overBranchFileContents with read-only unmerged git-annex branches

This makes --all error out in that situation. Which is better than
ignoring information from the branches.

To really handle the branches right, overBranchFileContents would need
to both query all the branches and union merge file contents
(or perhaps not provide any file content), as well as diffing between
branches to find files that are only present in the unmerged branches.
And also, it would need to handle transitions..

Sponsored-by: Dartmouth College's Datalad project
---

diff --git a/Annex/Branch.hs b/Annex/Branch.hs
index 2ee7c2fd18..a853d5de1d 100644
--- a/Annex/Branch.hs
+++ b/Annex/Branch.hs
@@ -820,13 +820,32 @@ rememberTreeishLocked treeish graftpoint jl = do
  - The action is passed a callback that it can repeatedly call to read
  - the next file and its contents. When there are no more files, the
  - callback will return Nothing.
+ -
+ - In some cases the callback may return the same file more than once,
+ - with different content. This happens rarely, only when the journal
+ - contains additional information, and the last version of the
+ - file it returns is the most current one.
+ -
+ - In a read-only repository that has other git-annex branches that have
+ - not been merged in, returns Nothing, because it's not possible to
+ - efficiently handle that.
  -}
 overBranchFileContents
 	:: (RawFilePath -> Maybe v)
 	-> (Annex (Maybe (v, RawFilePath, Maybe L.ByteString)) -> Annex a)
-	-> Annex a
+	-> Annex (Maybe a)
 overBranchFileContents select go = do
 	st <- update
+	if not (null (unmergedRefs st))
+		then return Nothing
+		else Just <$> overBranchFileContents' select go st
+
+overBranchFileContents'
+	:: (RawFilePath -> Maybe v)
+	-> (Annex (Maybe (v, RawFilePath, Maybe L.ByteString)) -> Annex a)
+	-> BranchState
+	-> Annex a
+overBranchFileContents' select go st = do
 	g <- Annex.gitRepo
 	(l, cleanup) <- inRepo $ Git.LsTree.lsTree
 		Git.LsTree.LsTreeRecursive
@@ -836,7 +855,7 @@ overBranchFileContents select go = do
 	buf <- liftIO newEmptyMVar
 	let go' reader = go $ liftIO reader >>= \case
 		Just ((v, f), content) -> do
-			content' <- checkjournal st f content
+			content' <- checkjournal f content
 			return (Just (v, f, content'))
 		Nothing
 			| journalIgnorable st -> return Nothing
@@ -853,7 +872,7 @@ overBranchFileContents select go = do
 		`finally` liftIO (void cleanup)
   where
 	-- Check the journal, in case it did not get committed to the branch
-	checkjournal st f branchcontent
+	checkjournal f branchcontent
 		| journalIgnorable st = return branchcontent
 		| otherwise = getJournalFileStale (GetPrivate True) f >>= return . \case
 			NoJournalledContent -> branchcontent
diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs
index 87eb1e333b..599a249e43 100644
--- a/CmdLine/Seek.hs
+++ b/CmdLine/Seek.hs
@@ -282,7 +282,9 @@ withKeyOptions' ko auto mkkeyaction fallbackaction worktreeitems = do
 				keyaction Nothing (SeekInput [], k, mkActionItem k)
 				go reader
 			Nothing -> return ()
-		Annex.Branch.overBranchFileContents getk go
+		Annex.Branch.overBranchFileContents getk go >>= \case
+			Just r -> return r
+			Nothing -> giveup "This repository is read-only, and there are unmerged git-annex branches, which prevents operating on all keys. (Set annex.merge-annex-branches to false to ignore the unmerged git-annex branches.)"
 
 	runkeyaction getks = do
 		keyaction <- mkkeyaction
diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs
index 267476f260..55b23bea6c 100644
--- a/Command/ImportFeed.hs
+++ b/Command/ImportFeed.hs
@@ -150,7 +150,9 @@ getCache opttemplate = ifM (Annex.getState Annex.force)
 {- Scan all url logs and metadata logs in the branch and find urls
  - and ItemIds that are already known. -}
 knownItems :: Annex ([URLString], [ItemId])
-knownItems = Annex.Branch.overBranchFileContents select (go [] [])
+knownItems = Annex.Branch.overBranchFileContents select (go [] []) >>= \case
+		Just r -> return r
+		Nothing -> giveup "This repository is read-only."
   where
 	select f
 		| isUrlLog f = Just ()
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index 3951b6b8da..08eff60715 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -1061,8 +1061,13 @@ repository, using [[git-annex-config]]. See its man page for a list.)
   are automatically merged into the local git-annex branch, so that
   git-annex has the most up-to-date possible knowledge.
 
-  To avoid that merging, set this to "false". This can be useful
-  particularly when you don't have write permission to the repository.
+  To avoid that merging, set this to "false". 
+
+  This can be useful particularly when you don't have write permission
+  to the repository. While git-annex is mostly able to work in a read-only
+  repository with unmerged git-annex branches, some things do not work,
+  and when it does work it will be slower due to needing to look at each of
+  the unmerged branches.
 
 * `annex.private`