graft in exported tree before updating the export log

It was possible for the export.log to get written and then git-annex was
interrupted, before it could graft in the exported tree. Which could
result in export.log referencing a tree that got garbage collected.
This commit is contained in:
Joey Hess 2024-06-07 14:56:44 -04:00
parent 43ff697f25
commit f5532be954
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38

View file

@ -66,19 +66,19 @@ recordExportBeginning remoteuuid newtree = do
. parseExportLogMap . parseExportLogMap
<$> Annex.Branch.get exportLog <$> Annex.Branch.get exportLog
let new = updateIncompleteExportedTreeish old (nub (newtree:incompleteExportedTreeishes [old])) let new = updateIncompleteExportedTreeish old (nub (newtree:incompleteExportedTreeishes [old]))
rememberExportTreeish newtree
Annex.Branch.change Annex.Branch.change
(Annex.Branch.RegardingUUID [remoteuuid, u]) (Annex.Branch.RegardingUUID [remoteuuid, u])
exportLog exportLog
(buildExportLog . changeMapLog c ep new . parseExportLog) (buildExportLog . changeMapLog c ep new . parseExportLog)
recordExportTreeish newtree
-- Graft 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 -- to ensure that it's available later, when getting exported files
-- from the remote. Since that could happen in another clone of the -- from the remote. Since that could happen in another clone of the
-- repository, the tree has to be kept available, even if it -- repository, the tree has to be kept available, even if it
-- doesn't end up being merged into the master branch. -- doesn't end up being merged into the master branch.
recordExportTreeish :: Git.Ref -> Annex () rememberExportTreeish :: Git.Ref -> Annex ()
recordExportTreeish t = void $ rememberExportTreeish t = void $
Annex.Branch.rememberTreeish t (asTopFilePath exportTreeGraftPoint) Annex.Branch.rememberTreeish t (asTopFilePath exportTreeGraftPoint)
-- | Record that an export to a special remote is under way. -- | Record that an export to a special remote is under way.
@ -112,7 +112,7 @@ recordExportUnderway remoteuuid ec = do
recordExport :: UUID -> Git.Ref -> ExportChange -> Annex () recordExport :: UUID -> Git.Ref -> ExportChange -> Annex ()
recordExport remoteuuid tree ec = do recordExport remoteuuid tree ec = do
when (oldTreeish ec /= [tree]) $ when (oldTreeish ec /= [tree]) $
recordExportTreeish tree rememberExportTreeish tree
recordExportUnderway remoteuuid ec recordExportUnderway remoteuuid ec
logExportExcluded :: UUID -> ((Git.Tree.TreeItem -> IO ()) -> Annex a) -> Annex a logExportExcluded :: UUID -> ((Git.Tree.TreeItem -> IO ()) -> Annex a) -> Annex a