forget: Preserve currently exported trees

Avoiding problems with exporttree remotes in some unusual circumstances.

This commit was sponsored by Brett Eisenberg on Patreon.

7 files changed, 36 insertions, 8 deletions

diff --git a/Annex/Branch.hs b/Annex/Branch.hs
index a187832542..ce4434e73b 100644
--- a/Annex/Branch.hs
+++ b/Annex/Branch.hs
@@ -71,6 +71,7 @@ import Logs.Transitions
 import Logs.File
 import Logs.Trust.Pure
 import Logs.Remote.Pure
+import Logs.Export.Pure
 import Logs.Difference.Pure
 import qualified Annex.Queue
 import Annex.Branch.Transitions
@@ -610,6 +611,7 @@ performTransitionsLocked jl ts neednewlocalbranch transitionedrefs = do
 			else do
 				ref <- getBranch
 				commitIndex jl ref message (nub $ fullname:transitionedrefs)
+	regraftexports
   where
 	message
 		| neednewlocalbranch && null transitionedrefs = "new branch for transition " ++ tdesc
@@ -638,6 +640,7 @@ performTransitionsLocked jl ts neednewlocalbranch transitionedrefs = do
 			content <- getStaged f
 			apply changers' f content
 		liftIO $ void cleanup
+	
 	apply [] _ _ = return ()
 	apply (changer:rest) file content = case changer file content of
 		PreserveFile -> apply rest file content
@@ -656,6 +659,15 @@ performTransitionsLocked jl ts neednewlocalbranch transitionedrefs = do
 						Git.UpdateIndex.updateIndexLine sha TreeFile (asTopFilePath file)
 					apply rest file content'
 
+	-- Trees mentioned in export.log were grafted into the old
+	-- git-annex branch to make sure they remain available. Re-graft
+	-- the trees into the new branch.
+	regraftexports = do
+		l <- exportedTreeishes . M.elems . parseExportLogMap
+			<$> getStaged exportLog
+		forM_ l $ \t ->
+			rememberTreeishLocked t (asTopFilePath exportTreeGraftPoint) jl
+
 checkBranchDifferences :: Git.Ref -> Annex ()
 checkBranchDifferences ref = do
 	theirdiffs <- allDifferences . parseDifferencesLog
@@ -708,7 +720,9 @@ getMergedRefs' = do
  - collected, and will always be available as long as the git-annex branch
  - is available. -}
 rememberTreeish :: Git.Ref -> TopFilePath -> Annex ()
-rememberTreeish treeish graftpoint = lockJournal $ \jl -> do
+rememberTreeish treeish graftpoint = lockJournal $ rememberTreeishLocked treeish graftpoint
+rememberTreeishLocked :: Git.Ref -> TopFilePath -> JournalLocked -> Annex ()
+rememberTreeishLocked treeish graftpoint jl = do
 	branchref <- getBranch
 	updateIndex jl branchref
 	origtree <- fromMaybe (giveup "unable to determine git-annex branch tree") <$>
diff --git a/Annex/Branch/Transitions.hs b/Annex/Branch/Transitions.hs
index 98b7b635a4..d368d80974 100644
--- a/Annex/Branch/Transitions.hs
+++ b/Annex/Branch/Transitions.hs
@@ -45,7 +45,7 @@ getTransitionCalculator ForgetDeadRemotes = Just dropDead
 -- Removes data about all dead repos.
 --
 -- The trust log is not changed, because other, unmerged clones
--- may contain other data about the dead repos. So we need to rememebr
+-- may contain other data about the dead repos. So we need to remember
 -- which are dead to later remove that.
 --
 -- When the remote log contains a sameas-uuid pointing to a dead uuid,
diff --git a/CHANGELOG b/CHANGELOG
index 877f7ddd5a..e873779817 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -5,6 +5,8 @@ git-annex (8.20210331) UNRELEASED; urgency=medium
     enabled.
   * Added --debugfilter (and annex.debugfilter)
   * diffdriver: Support unlocked files.
+  * forget: Preserve currently exported trees, avoiding problems with
+    exporttree remotes in some unusual circumstances.
 
  -- Joey Hess <id@joeyh.name>  Thu, 01 Apr 2021 12:17:26 -0400
 
diff --git a/Logs.hs b/Logs.hs
index 50b955420f..b8b1565286 100644
--- a/Logs.hs
+++ b/Logs.hs
@@ -139,6 +139,11 @@ multicastLog = "multicast.log"
 exportLog :: RawFilePath
 exportLog = "export.log"
 
+{- This is not a log file, it's where exported treeishes get grafted into
+ - the git-annex branch. -}
+exportTreeGraftPoint :: RawFilePath
+exportTreeGraftPoint = "export.tree"
+
 {- The pathname of the location log file for a given key. -}
 locationLogFile :: GitConfig -> Key -> RawFilePath
 locationLogFile config key =
diff --git a/Logs/Export.hs b/Logs/Export.hs
index 738136de42..d86af5fc2f 100644
--- a/Logs/Export.hs
+++ b/Logs/Export.hs
@@ -43,8 +43,8 @@ import Data.Char
 
 -- | Get what's been exported to a special remote.
 getExport :: UUID -> Annex [Exported]
-getExport remoteuuid = nub . mapMaybe get . M.toList . simpleMap 
-	. parseExportLog
+getExport remoteuuid = nub . mapMaybe get . M.toList
+	. parseExportLogMap
 	<$> Annex.Branch.get exportLog
   where
 	get (ep, exported)
@@ -61,8 +61,8 @@ recordExportBeginning remoteuuid newtree = do
 	u <- getUUID
 	let ep = ExportParticipants { exportFrom = u, exportTo = remoteuuid }
 	old <- fromMaybe (mkExported emptyTree [])
-		. M.lookup ep . simpleMap 
-		. parseExportLog
+		. M.lookup ep
+		. parseExportLogMap
 		<$> Annex.Branch.get exportLog
 	let new = updateIncompleteExportedTreeish old (nub (newtree:incompleteExportedTreeishes [old]))
 	Annex.Branch.change exportLog $
@@ -71,14 +71,14 @@ recordExportBeginning remoteuuid newtree = do
 			. parseExportLog
 	recordExportTreeish newtree
 
--- Grade a tree ref into the git-annex branch. This is done
+-- Graft a tree ref into the git-annex branch. This is done
 -- to ensure that it's available later, when getting exported files
 -- from the remote. Since that could happen in another clone of the
 -- repository, the tree has to be kept available, even if it
 -- doesn't end up being merged into the master branch.
 recordExportTreeish :: Git.Ref -> Annex ()
 recordExportTreeish t = 
-	Annex.Branch.rememberTreeish t (asTopFilePath "export.tree")
+	Annex.Branch.rememberTreeish t (asTopFilePath exportTreeGraftPoint)
 
 -- | Record that an export to a special remote is under way.
 --
diff --git a/Logs/Export/Pure.hs b/Logs/Export/Pure.hs
index 1ccc3a2909..ccb31e4d54 100644
--- a/Logs/Export/Pure.hs
+++ b/Logs/Export/Pure.hs
@@ -17,6 +17,7 @@ module Logs.Export.Pure (
 	exportedTreeishes,
 	incompleteExportedTreeishes,
 	parseExportLog,
+	parseExportLogMap,
 	buildExportLog,
 	updateForExportChange,
 ) where
@@ -25,6 +26,7 @@ import Annex.Common
 import qualified Git
 import Logs.MapLog
 
+import qualified Data.Map as M
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Attoparsec.ByteString.Lazy as A
 import qualified Data.Attoparsec.ByteString.Char8 as A8
@@ -72,6 +74,9 @@ data ExportChange = ExportChange
 parseExportLog :: L.ByteString -> MapLog ExportParticipants Exported
 parseExportLog = parseMapLog exportParticipantsParser exportedParser
 
+parseExportLogMap :: L.ByteString -> M.Map ExportParticipants Exported
+parseExportLogMap = simpleMap . parseExportLog
+
 buildExportLog :: MapLog ExportParticipants Exported -> Builder
 buildExportLog = buildMapLog buildExportParticipants buildExported
 
diff --git a/doc/bugs/git_annex_forget_can_confuse_updating_exporttree_remotes.mdwn b/doc/bugs/git_annex_forget_can_confuse_updating_exporttree_remotes.mdwn
index 280faf9636..834da7a186 100644
--- a/doc/bugs/git_annex_forget_can_confuse_updating_exporttree_remotes.mdwn
+++ b/doc/bugs/git_annex_forget_can_confuse_updating_exporttree_remotes.mdwn
@@ -39,3 +39,5 @@ A solution might be for the branch transition code to preserve old commits
 that add/remove export.tree. Or, the branch transition code could examine
 the export.log to find the trees that it refers to, and re-graft those back
 into the new git-annex branch.
+
+> [[fixed|done]] --[[Joey]]