annex.adjustedbranchrefresh

Added annex.adjustedbranchrefresh git config to update adjusted branches
set up by git-annex adjust --unlock-present/--hide-missing.

Note, in a few cases, I was not able to make the adjusted branch
be updated in calls to moveAnnex, because information about what
file corresponds to a key is not available. They are:

* If two files point to one file, then eg, `git annex get foo` will
  update the branch to unlock foo, but will not unlock bar, because it
  does not know about it. Might be fixable by making `git annex get
  bar` do something besides skipping bar?
* git-annex-shell recvkey likewise (so sends over ssh from old versions
  of git-annex)
* git-annex setkey
* git-annex transferkey if the user does not use --file
* git-annex multicast sends keys with no associated file info

Doing a single full refresh at the end, after any incremental refresh,
will deal with those edge cases.

Annex.hs

@@ -143,6 +143,7 @@ data AnnexState = AnnexState
 	, sentinalstatus :: Maybe SentinalStatus
 	, useragent :: Maybe String
 	, errcounter :: Integer
+	, adjustedbranchrefreshcounter :: Integer
 	, unusedkeys :: Maybe (S.Set Key)
 	, tempurls :: M.Map Key URLString
 	, existinghooks :: M.Map Git.Hook.Hook Bool
@@ -203,6 +204,7 @@ newState c r = do
 		, sentinalstatus = Nothing
 		, useragent = Nothing
 		, errcounter = 0
+		, adjustedbranchrefreshcounter = 0
 		, unusedkeys = Nothing
 		, tempurls = M.empty
 		, existinghooks = M.empty
@@ -399,8 +401,8 @@ changeDirectory d = do
 
 incError :: Annex ()
 incError = changeState $ \s -> 
-	let ! c = errcounter s + 1 
-	    ! s' = s { errcounter = c }
+	let !c = errcounter s + 1 
+	    !s' = s { errcounter = c }
 	in s'
 
 getGitRemotes :: Annex [Git.Repo]

Annex/AdjustedBranch.hs

@@ -22,10 +22,18 @@ module Annex.AdjustedBranch (
 	getAdjustment,
 	enterAdjustedBranch,
 	updateAdjustedBranch,
+	adjustedBranchRefresh,
 	adjustBranch,
+	adjustTree,
 	adjustToCrippledFileSystem,
-	mergeToAdjustedBranch,
 	propigateAdjustedCommits,
+	propigateAdjustedCommits',
+	commitAdjustedTree,
+	commitAdjustedTree',
+	BasisBranch(..),
+	basisBranch,
+	setBasisBranch,
+	preventCommits,
 	AdjustedClone(..),
 	checkAdjustedClone,
 	checkVersionSupported,
@@ -43,7 +51,6 @@ import qualified Git.Ref
 import qualified Git.Command
 import qualified Git.Tree
 import qualified Git.DiffTree
-import qualified Git.Merge
 import Git.Tree (TreeItem(..))
 import Git.Sha
 import Git.Env
@@ -53,19 +60,13 @@ import qualified Git.LockFile
 import qualified Git.Version
 import Annex.CatFile
 import Annex.Link
-import Annex.AutoMerge
-import Annex.Content
-import Annex.Tmp
-import Annex.GitOverlay
-import Utility.Tmp.Dir
-import Utility.CopyFile
-import Utility.Directory.Create
+import Annex.Content.Presence
+import Annex.CurrentBranch
+import Types.CleanupActions
 import qualified Database.Keys
 import Config
 
 import qualified Data.Map as M
-import qualified Data.ByteString as S
-import qualified System.FilePath.ByteString as P
 
 class AdjustTreeItem t where
 	-- How to perform various adjustments to a TreeItem.
@@ -272,6 +273,52 @@ updateAdjustedBranch adj (AdjBranch currbranch) origbranch
 		-- adjustment is stable.
 		return True
 
+{- Passed an action that, if it succeeds may get or drop the Key associated
+ - with the file. When the adjusted branch needs to be refreshed to reflect
+ - those changes, it's handled here.
+ -
+ - Note that the AssociatedFile must be verified by this to point to the
+ - Key. In some cases, the value was provided by the user and might not
+ - really be an associated file.
+ -}
+adjustedBranchRefresh :: AssociatedFile -> Annex a -> Annex a
+adjustedBranchRefresh _af a = do
+	r <- a
+	annexAdjustedBranchRefresh <$> Annex.getGitConfig >>= \case
+		0 -> return ()
+		n -> go n
+	return r
+  where
+	go n = getCurrentBranch >>= \case
+		(Just origbranch, Just adj) ->
+			unless (adjustmentIsStable adj) $
+				ifM (checkcounter n)
+					( update adj origbranch
+					, Annex.addCleanup AdjustedBranchUpdate $
+						update adj origbranch
+					)
+		_ -> return ()
+	
+	checkcounter n
+		-- Special case, 1 (or true) refreshes only at shutdown.
+		| n == 1 = pure False
+		| n == 2 = pure True
+		| otherwise = Annex.withState $ \s -> 
+			let !c = Annex.adjustedbranchrefreshcounter s + 1
+			    !enough = c >= pred n
+			    !c' = if enough then 0 else c
+			    !s' = s { Annex.adjustedbranchrefreshcounter = c' }
+			    in pure (s', enough)
+	
+	-- TODO This is very slow when run a lot of times. 
+	-- Incrementally adjust only the AssociatedFile.
+	-- However, this should be run once at shutdown then,
+	-- because other files than the provided AssociatedFile
+	-- can need to be updated in some edge cases.
+	update adj origbranch = do
+		let adjbranch = originalToAdjusted origbranch adj
+		void $ updateAdjustedBranch adj adjbranch origbranch
+
 adjustToCrippledFileSystem :: Annex ()
 adjustToCrippledFileSystem = do
 	warning "Entering an adjusted branch where files are unlocked as this filesystem does not support locked files."
@@ -389,137 +436,6 @@ findAdjustingCommit (AdjBranch b) = go =<< catCommit b
 			[p] -> go =<< catCommit p
 			_ -> return Nothing
 
-{- Update the currently checked out adjusted branch, merging the provided
- - branch into it. Note that the provided branch should be a non-adjusted
- - branch. -}
-mergeToAdjustedBranch :: Branch -> (OrigBranch, Adjustment) -> [Git.Merge.MergeConfig] -> Bool -> Git.Branch.CommitMode -> Annex Bool
-mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge commitmode = catchBoolIO $
-	join $ preventCommits go
-  where
-	adjbranch@(AdjBranch currbranch) = originalToAdjusted origbranch adj
-	basis = basisBranch adjbranch
-
-	go commitsprevented =
-		ifM (inRepo $ Git.Branch.changed currbranch tomerge)
-			( do
-				(updatedorig, _) <- propigateAdjustedCommits'
-					origbranch adj commitsprevented
-				changestomerge updatedorig
-			, nochangestomerge
-			)
-
-	nochangestomerge = return $ return True
-
-	{- Since the adjusted branch changes files, merging tomerge
-	 - directly into it would likely result in unncessary merge
-	 - conflicts. To avoid those conflicts, instead merge tomerge into
-	 - updatedorig. The result of the merge can the be
-	 - adjusted to yield the final adjusted branch.
-	 -
-	 - In order to do a merge into a ref that is not checked out,
-	 - set the work tree to a temp directory, and set GIT_DIR
-	 - to another temp directory, in which HEAD contains the
-	 - updatedorig sha. GIT_COMMON_DIR is set to point to the real
-	 - git directory, and so git can read and write objects from there,
-	 - but will use GIT_DIR for HEAD and index.
-	 -
-	 - (Doing the merge this way also lets it run even though the main
-	 - index file is currently locked.)
-	 -}
-	changestomerge (Just updatedorig) = withOtherTmp $ \othertmpdir -> do
-		git_dir <- fromRepo Git.localGitDir
-		let git_dir' = fromRawFilePath git_dir
-		tmpwt <- fromRepo gitAnnexMergeDir
-		withTmpDirIn (fromRawFilePath othertmpdir) "git" $ \tmpgit -> withWorkTreeRelated tmpgit $
-			withemptydir git_dir tmpwt $ withWorkTree tmpwt $ do
-				liftIO $ writeFile (tmpgit </> "HEAD") (fromRef updatedorig)
-				-- Copy in refs and packed-refs, to work
-				-- around bug in git 2.13.0, which
-				-- causes it not to look in GIT_DIR for refs.
-				refs <- liftIO $ dirContentsRecursive $
-					git_dir' </> "refs"
-				let refs' = (git_dir' </> "packed-refs") : refs
-				liftIO $ forM_ refs' $ \src ->
-					whenM (doesFileExist src) $ do
-						dest <- relPathDirToFile git_dir
-							(toRawFilePath src)
-						let dest' = toRawFilePath tmpgit P.</> dest
-						createDirectoryUnder git_dir
-							(P.takeDirectory dest')
-						void $ createLinkOrCopy src
-							(fromRawFilePath dest')
-				-- This reset makes git merge not care
-				-- that the work tree is empty; otherwise
-				-- it will think that all the files have
-				-- been staged for deletion, and sometimes
-				-- the merge includes these deletions
-				-- (for an unknown reason).
-				-- http://thread.gmane.org/gmane.comp.version-control.git/297237
-				inRepo $ Git.Command.run [Param "reset", Param "HEAD", Param "--quiet"]
-				showAction $ "Merging into " ++ fromRef (Git.Ref.base origbranch)
-				merged <- autoMergeFrom' tomerge Nothing mergeconfig commitmode True
-					(const $ resolveMerge (Just updatedorig) tomerge True)
-				if merged
-					then do
-						!mergecommit <- liftIO $ extractSha
-							<$> S.readFile (tmpgit </> "HEAD")
-						-- This is run after the commit lock is dropped.
-						return $ postmerge mergecommit
-					else return $ return False
-	changestomerge Nothing = return $ return False
-	
-	withemptydir git_dir d a = bracketIO setup cleanup (const a)
-	  where
-		setup = do
-			whenM (doesDirectoryExist d) $
-				removeDirectoryRecursive d
-			createDirectoryUnder git_dir (toRawFilePath d)
-		cleanup _ = removeDirectoryRecursive d
-
-	{- A merge commit has been made between the basisbranch and 
-	 - tomerge. Update the basisbranch and origbranch to point
-	 - to that commit, adjust it to get the new adjusted branch,
-	 - and check it out.
-	 -
-	 - But, there may be unstaged work tree changes that conflict, 
-	 - so the check out is done by making a normal merge of
-	 - the new adjusted branch.
-	 -}
-	postmerge (Just mergecommit) = do
-		setBasisBranch basis mergecommit
-		inRepo $ Git.Branch.update' origbranch mergecommit
-		adjtree <- adjustTree adj (BasisBranch mergecommit)
-		adjmergecommit <- commitAdjustedTree adjtree (BasisBranch mergecommit)
-		-- Make currbranch be the parent, so that merging
-		-- this commit will be a fast-forward.
-		adjmergecommitff <- commitAdjustedTree' adjtree (BasisBranch mergecommit) [currbranch]
-		showAction "Merging into adjusted branch"
-		ifM (autoMergeFrom adjmergecommitff (Just currbranch) mergeconfig commitmode canresolvemerge)
-			( reparent adjtree adjmergecommit =<< getcurrentcommit
-			, return False
-			)
-	postmerge Nothing = return False
-
-	-- Now that the merge into the adjusted branch is complete,
-	-- take the tree from that merge, and attach it on top of the
-	-- adjmergecommit, if it's different.
-	reparent adjtree adjmergecommit (Just currentcommit) = do
-		if (commitTree currentcommit /= adjtree)
-			then do
-				cmode <- annexCommitMode <$> Annex.getGitConfig
-				c <- inRepo $ Git.Branch.commitTree cmode
-					("Merged " ++ fromRef tomerge) [adjmergecommit]
-					(commitTree currentcommit)
-				inRepo $ Git.Branch.update "updating adjusted branch" currbranch c
-				propigateAdjustedCommits origbranch adj
-			else inRepo $ Git.Branch.update "updating adjusted branch" currbranch adjmergecommit
-		return True
-	reparent _ _ Nothing = return False
-
-	getcurrentcommit = inRepo Git.Branch.currentUnsafe >>= \case
-		Nothing -> return Nothing
-		Just c -> catCommit c
-
 {- Check for any commits present on the adjusted branch that have not yet
  - been propigated to the basis branch, and propigate them to the basis
  - branch and from there on to the orig branch.

Annex/AdjustedBranch/Merge.hs

@@ -0,0 +1,164 @@
+{- adjusted branch merging
+ -
+ - Copyright 2016-2020 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+{-# LANGUAGE BangPatterns, OverloadedStrings #-}
+
+module Annex.AdjustedBranch.Merge (
+	mergeToAdjustedBranch,
+) where
+
+import Annex.Common
+import Annex.AdjustedBranch
+import qualified Annex
+import Git
+import Git.Types
+import qualified Git.Branch
+import qualified Git.Ref
+import qualified Git.Command
+import qualified Git.Merge
+import Git.Sha
+import Annex.CatFile
+import Annex.AutoMerge
+import Annex.Tmp
+import Annex.GitOverlay
+import Utility.Tmp.Dir
+import Utility.CopyFile
+import Utility.Directory.Create
+
+import qualified Data.ByteString as S
+import qualified System.FilePath.ByteString as P
+
+{- Update the currently checked out adjusted branch, merging the provided
+ - branch into it. Note that the provided branch should be a non-adjusted
+ - branch. -}
+mergeToAdjustedBranch :: Branch -> (OrigBranch, Adjustment) -> [Git.Merge.MergeConfig] -> Bool -> Git.Branch.CommitMode -> Annex Bool
+mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge commitmode = catchBoolIO $
+	join $ preventCommits go
+  where
+	adjbranch@(AdjBranch currbranch) = originalToAdjusted origbranch adj
+	basis = basisBranch adjbranch
+
+	go commitsprevented =
+		ifM (inRepo $ Git.Branch.changed currbranch tomerge)
+			( do
+				(updatedorig, _) <- propigateAdjustedCommits'
+					origbranch adj commitsprevented
+				changestomerge updatedorig
+			, nochangestomerge
+			)
+
+	nochangestomerge = return $ return True
+
+	{- Since the adjusted branch changes files, merging tomerge
+	 - directly into it would likely result in unncessary merge
+	 - conflicts. To avoid those conflicts, instead merge tomerge into
+	 - updatedorig. The result of the merge can the be
+	 - adjusted to yield the final adjusted branch.
+	 -
+	 - In order to do a merge into a ref that is not checked out,
+	 - set the work tree to a temp directory, and set GIT_DIR
+	 - to another temp directory, in which HEAD contains the
+	 - updatedorig sha. GIT_COMMON_DIR is set to point to the real
+	 - git directory, and so git can read and write objects from there,
+	 - but will use GIT_DIR for HEAD and index.
+	 -
+	 - (Doing the merge this way also lets it run even though the main
+	 - index file is currently locked.)
+	 -}
+	changestomerge (Just updatedorig) = withOtherTmp $ \othertmpdir -> do
+		git_dir <- fromRepo Git.localGitDir
+		let git_dir' = fromRawFilePath git_dir
+		tmpwt <- fromRepo gitAnnexMergeDir
+		withTmpDirIn (fromRawFilePath othertmpdir) "git" $ \tmpgit -> withWorkTreeRelated tmpgit $
+			withemptydir git_dir tmpwt $ withWorkTree tmpwt $ do
+				liftIO $ writeFile (tmpgit </> "HEAD") (fromRef updatedorig)
+				-- Copy in refs and packed-refs, to work
+				-- around bug in git 2.13.0, which
+				-- causes it not to look in GIT_DIR for refs.
+				refs <- liftIO $ dirContentsRecursive $
+					git_dir' </> "refs"
+				let refs' = (git_dir' </> "packed-refs") : refs
+				liftIO $ forM_ refs' $ \src ->
+					whenM (doesFileExist src) $ do
+						dest <- relPathDirToFile git_dir
+							(toRawFilePath src)
+						let dest' = toRawFilePath tmpgit P.</> dest
+						createDirectoryUnder git_dir
+							(P.takeDirectory dest')
+						void $ createLinkOrCopy src
+							(fromRawFilePath dest')
+				-- This reset makes git merge not care
+				-- that the work tree is empty; otherwise
+				-- it will think that all the files have
+				-- been staged for deletion, and sometimes
+				-- the merge includes these deletions
+				-- (for an unknown reason).
+				-- http://thread.gmane.org/gmane.comp.version-control.git/297237
+				inRepo $ Git.Command.run [Param "reset", Param "HEAD", Param "--quiet"]
+				showAction $ "Merging into " ++ fromRef (Git.Ref.base origbranch)
+				merged <- autoMergeFrom' tomerge Nothing mergeconfig commitmode True
+					(const $ resolveMerge (Just updatedorig) tomerge True)
+				if merged
+					then do
+						!mergecommit <- liftIO $ extractSha
+							<$> S.readFile (tmpgit </> "HEAD")
+						-- This is run after the commit lock is dropped.
+						return $ postmerge mergecommit
+					else return $ return False
+	changestomerge Nothing = return $ return False
+	
+	withemptydir git_dir d a = bracketIO setup cleanup (const a)
+	  where
+		setup = do
+			whenM (doesDirectoryExist d) $
+				removeDirectoryRecursive d
+			createDirectoryUnder git_dir (toRawFilePath d)
+		cleanup _ = removeDirectoryRecursive d
+
+	{- A merge commit has been made between the basisbranch and 
+	 - tomerge. Update the basisbranch and origbranch to point
+	 - to that commit, adjust it to get the new adjusted branch,
+	 - and check it out.
+	 -
+	 - But, there may be unstaged work tree changes that conflict, 
+	 - so the check out is done by making a normal merge of
+	 - the new adjusted branch.
+	 -}
+	postmerge (Just mergecommit) = do
+		setBasisBranch basis mergecommit
+		inRepo $ Git.Branch.update' origbranch mergecommit
+		adjtree <- adjustTree adj (BasisBranch mergecommit)
+		adjmergecommit <- commitAdjustedTree adjtree (BasisBranch mergecommit)
+		-- Make currbranch be the parent, so that merging
+		-- this commit will be a fast-forward.
+		adjmergecommitff <- commitAdjustedTree' adjtree (BasisBranch mergecommit) [currbranch]
+		showAction "Merging into adjusted branch"
+		ifM (autoMergeFrom adjmergecommitff (Just currbranch) mergeconfig commitmode canresolvemerge)
+			( reparent adjtree adjmergecommit =<< getcurrentcommit
+			, return False
+			)
+	postmerge Nothing = return False
+
+	-- Now that the merge into the adjusted branch is complete,
+	-- take the tree from that merge, and attach it on top of the
+	-- adjmergecommit, if it's different.
+	reparent adjtree adjmergecommit (Just currentcommit) = do
+		if (commitTree currentcommit /= adjtree)
+			then do
+				cmode <- annexCommitMode <$> Annex.getGitConfig
+				c <- inRepo $ Git.Branch.commitTree cmode
+					("Merged " ++ fromRef tomerge) [adjmergecommit]
+					(commitTree currentcommit)
+				inRepo $ Git.Branch.update "updating adjusted branch" currbranch c
+				propigateAdjustedCommits origbranch adj
+			else inRepo $ Git.Branch.update "updating adjusted branch" currbranch adjmergecommit
+		return True
+	reparent _ _ Nothing = return False
+
+	getcurrentcommit = inRepo Git.Branch.currentUnsafe >>= \case
+		Nothing -> return Nothing
+		Just c -> catCommit c

Annex/Content.hs

@@ -76,6 +76,7 @@ import Annex.Link
 import Annex.LockPool
 import Annex.UUID
 import Annex.InodeSentinal
+import Annex.AdjustedBranch (adjustedBranchRefresh)
 import Messages.Progress
 import Types.Remote (RetrievalSecurityPolicy(..))
 import Types.NumCopies
@@ -203,15 +204,15 @@ lockContentUsing locker key fallback a = do
 {- Runs an action, passing it the temp file to get,
  - and if the action succeeds, verifies the file matches
  - the key and moves the file into the annex as a key's content. -}
-getViaTmp :: RetrievalSecurityPolicy -> VerifyConfig -> Key -> (RawFilePath -> Annex (Bool, Verification)) -> Annex Bool
-getViaTmp rsp v key action = checkDiskSpaceToGet key False $
-	getViaTmpFromDisk rsp v key action
+getViaTmp :: RetrievalSecurityPolicy -> VerifyConfig -> Key -> AssociatedFile -> (RawFilePath -> Annex (Bool, Verification)) -> Annex Bool
+getViaTmp rsp v key af action = checkDiskSpaceToGet key False $
+	getViaTmpFromDisk rsp v key af action
 
 {- Like getViaTmp, but does not check that there is enough disk space
  - for the incoming key. For use when the key content is already on disk
  - and not being copied into place. -}
-getViaTmpFromDisk :: RetrievalSecurityPolicy -> VerifyConfig -> Key -> (RawFilePath -> Annex (Bool, Verification)) -> Annex Bool
-getViaTmpFromDisk rsp v key action = checkallowed $ do
+getViaTmpFromDisk :: RetrievalSecurityPolicy -> VerifyConfig -> Key -> AssociatedFile -> (RawFilePath -> Annex (Bool, Verification)) -> Annex Bool
+getViaTmpFromDisk rsp v key af action = checkallowed $ do
 	tmpfile <- prepTmp key
 	resuming <- liftIO $ R.doesPathExist tmpfile
 	(ok, verification) <- action tmpfile
@@ -226,7 +227,7 @@ getViaTmpFromDisk rsp v key action = checkallowed $ do
 		else verification
 	if ok
 		then ifM (verifyKeyContent rsp v verification' key tmpfile)
-			( ifM (pruneTmpWorkDirBefore tmpfile (moveAnnex key))
+			( ifM (pruneTmpWorkDirBefore tmpfile (moveAnnex key af))
 				( do
 					logStatus key InfoPresent
 					return True
@@ -329,8 +330,8 @@ withTmp key action = do
  - accepted into the repository. Will display a warning message in this
  - case. May also throw exceptions in some cases.
  -}
-moveAnnex :: Key -> RawFilePath -> Annex Bool
-moveAnnex key src = ifM (checkSecureHashes' key)
+moveAnnex :: Key -> AssociatedFile -> RawFilePath -> Annex Bool
+moveAnnex key af src = ifM (checkSecureHashes' key)
 	( do
 		withObjectLoc key storeobject
 		return True
@@ -339,7 +340,7 @@ moveAnnex key src = ifM (checkSecureHashes' key)
   where
 	storeobject dest = ifM (liftIO $ R.doesPathExist dest)
 		( alreadyhave
-		, modifyContent dest $ do
+		, adjustedBranchRefresh af $ modifyContent dest $ do
 			freezeContent src
 			liftIO $ moveFile
 				(fromRawFilePath src)
@@ -500,8 +501,7 @@ cleanObjectLoc key cleaner = do
 		maybe noop (const $ removeparents dir (n-1))
 			<=< catchMaybeIO $ removeDirectory (fromRawFilePath dir)
 
-{- Removes a key's file from .git/annex/objects/
- -}
+{- Removes a key's file from .git/annex/objects/ -}
 removeAnnex :: ContentRemovalLock -> Annex ()
 removeAnnex (ContentRemovalLock key) = withObjectLoc key $ \file ->
 	cleanObjectLoc key $ do
@@ -515,7 +515,8 @@ removeAnnex (ContentRemovalLock key) = withObjectLoc key $ \file ->
 	-- Check associated pointer file for modifications, and reset if
 	-- it's unmodified.
 	resetpointer file = ifM (isUnmodified key file)
-		( depopulatePointerFile key file
+		( adjustedBranchRefresh (AssociatedFile (Just file)) $
+			depopulatePointerFile key file
 		-- Modified file, so leave it alone.
 		-- If it was a hard link to the annex object,
 		-- that object might have been frozen as part of the

Annex/Import.hs

@@ -460,7 +460,7 @@ importKeys remote importtreeconfig importcontent importablecontents = do
 					ia loc cid (fromRawFilePath tmpfile)
 					(pure k)
 					(combineMeterUpdate p' p)
-				ok <- moveAnnex k' tmpfile
+				ok <- moveAnnex k' af tmpfile
 				when ok $
 					logStatus k InfoPresent
 				return (Just (k', ok))
@@ -503,7 +503,7 @@ importKeys remote importtreeconfig importcontent importablecontents = do
 				p
 			case keyGitSha k of
 				Nothing -> do
-					ok <- moveAnnex k tmpfile
+					ok <- moveAnnex k af tmpfile
 					when ok $ do
 						recordcidkey cidmap db cid k
 						logStatus k InfoPresent

Annex/Ingest.hs

@@ -177,13 +177,19 @@ ingest' preferredbackend meterupdate (Just (LockedDown cfg source)) mk restage =
 	go _ _ Nothing = failure "failed to generate a key"
 
 	golocked key mcache s =
-		tryNonAsync (moveAnnex key $ contentLocation source) >>= \case
+		tryNonAsync (moveAnnex key naf (contentLocation source)) >>= \case
 			Right True -> do
 				populateAssociatedFiles key source restage
 				success key mcache s		
 			Right False -> giveup "failed to add content to annex"
 			Left e -> restoreFile (keyFilename source) key e
 
+	-- moveAnnex uses the AssociatedFile provided to it to unlock
+	-- locked files when getting a file in an adjusted branch.
+	-- That case does not apply here, where we're adding an unlocked
+	-- file, so provide it nothing.
+	naf = AssociatedFile Nothing
+
 	gounlocked key (Just cache) s = do
 		-- Remove temp directory hard link first because
 		-- linkToAnnex falls back to copying if a file
@@ -352,7 +358,7 @@ addAnnexedFile ci matcher file key mtmp = ifM (addUnlocked matcher mi)
 		stagePointerFile file mode =<< hashPointerFile key
 		Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath file)
 		case mtmp of
-			Just tmp -> ifM (moveAnnex key tmp)
+			Just tmp -> ifM (moveAnnex key af tmp)
 				( linkunlocked mode >> return True
 				, writepointer mode >> return False
 				)
@@ -363,10 +369,11 @@ addAnnexedFile ci matcher file key mtmp = ifM (addUnlocked matcher mi)
 	, do
 		addLink ci file key Nothing
 		case mtmp of
-			Just tmp -> moveAnnex key tmp
+			Just tmp -> moveAnnex key af tmp
 			Nothing -> return True
 	)
   where
+	af = AssociatedFile (Just file)
 	mi = case mtmp of
 		Just tmp -> MatchingFile $ FileInfo
 			{ contentFile = Just tmp

CHANGELOG

@@ -3,6 +3,8 @@ git-annex (8.20201117) UNRELEASED; urgency=medium
   * adjust: New --unlock-present mode which locks files whose content is not
     present (so the broken symlink is visible), while unlocking files whose
     content is present.
+  * Added annex.adjustedbranchrefresh git config to update adjusted
+    branches set up by git-annex adjust --unlock-present/--hide-missing.
   * examinekey: Added a "file" format variable for consistency with find,
     and for easier scripting.
 

Command/Get.hs

@@ -114,7 +114,7 @@ getKey' key afile = dispatch
 		| Remote.hasKeyCheap r =
 			either (const False) id <$> Remote.hasKey r key
 		| otherwise = return True
-	docopy r witness = getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) key $ \dest ->
+	docopy r witness = getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) key afile $ \dest ->
 		download (Remote.uuid r) key afile stdRetry
 			(\p -> do
 				showAction $ "from " ++ Remote.name r

Command/Move.hs

@@ -225,7 +225,7 @@ fromPerform src removewhen key afile = do
   where
 	get = notifyTransfer Download afile $ 
 		download (Remote.uuid src) key afile stdRetry $ \p ->
-			getViaTmp (Remote.retrievalSecurityPolicy src) (RemoteVerify src) key $ \t ->
+			getViaTmp (Remote.retrievalSecurityPolicy src) (RemoteVerify src) key afile $ \t ->
 				Remote.verifiedAction $ Remote.retrieveKeyFile src key afile (fromRawFilePath t) p
 	
 	dispatch _ _ False = stop -- failed

Command/Multicast.hs

@@ -212,7 +212,7 @@ storeReceived f = do
 			warning $ "Received a file " ++ f ++ " that is not a git-annex key. Deleting this file."
 			liftIO $ removeWhenExistsWith removeLink f
 		Just k -> void $
-			getViaTmpFromDisk RetrievalVerifiableKeysSecure AlwaysVerify k $ \dest -> unVerified $
+			getViaTmpFromDisk RetrievalVerifiableKeysSecure AlwaysVerify k (AssociatedFile Nothing) $ \dest -> unVerified $
 				liftIO $ catchBoolIO $ do
 					rename f (fromRawFilePath dest)
 					return True

Command/ReKey.hs

@@ -90,7 +90,7 @@ linkKey file oldkey newkey = ifM (isJust <$> isAnnexLink file)
 	 - This avoids hard linking to content linked to an
 	 - unlocked file, which would leave the new key unlocked
 	 - and vulnerable to corruption. -}
-	( getViaTmpFromDisk RetrievalAllKeysSecure DefaultVerify newkey $ \tmp -> unVerified $ do
+	( getViaTmpFromDisk RetrievalAllKeysSecure DefaultVerify newkey (AssociatedFile Nothing) $ \tmp -> unVerified $ do
 		oldobj <- calcRepo (gitAnnexLocation oldkey)
 		isJust <$> linkOrCopy' (return True) newkey oldobj tmp Nothing
 	, do

Command/RecvKey.hs

@@ -33,7 +33,7 @@ start (_, key) = fieldTransfer Download key $ \_p -> do
 	let verify = if fromunlocked then AlwaysVerify else DefaultVerify
 	-- This matches the retrievalSecurityPolicy of Remote.Git
 	let rsp = RetrievalAllKeysSecure
-	ifM (getViaTmp rsp verify key go)
+	ifM (getViaTmp rsp verify key (AssociatedFile Nothing) go)
 		( do
 			-- forcibly quit after receiving one key,
 			-- and shutdown cleanly

Command/Reinject.hs

@@ -88,7 +88,7 @@ perform src key = ifM move
 	)
   where
 	move = checkDiskSpaceToGet key False $
-		moveAnnex key src
+		moveAnnex key (AssociatedFile Nothing) src
 
 cleanup :: Key -> CommandCleanup
 cleanup key = do

Command/SetKey.hs

@@ -35,7 +35,7 @@ perform file key = do
 	-- the file might be on a different filesystem, so moveFile is used
 	-- rather than simply calling moveAnnex; disk space is also
 	-- checked this way.
-	ok <- getViaTmp RetrievalAllKeysSecure DefaultVerify key $ \dest -> unVerified $
+	ok <- getViaTmp RetrievalAllKeysSecure DefaultVerify key (AssociatedFile Nothing) $ \dest -> unVerified $
 		if dest /= file
 			then liftIO $ catchBoolIO $ do
 				moveFile (fromRawFilePath file) (fromRawFilePath dest)

Command/Sync.hs

@@ -60,6 +60,7 @@ import Logs.Export
 import Logs.PreferredContent
 import Annex.AutoMerge
 import Annex.AdjustedBranch
+import Annex.AdjustedBranch.Merge
 import Annex.Ssh
 import Annex.BloomFilter
 import Annex.UpdateInstead

Command/TestRemote.hs

@@ -294,7 +294,7 @@ test runannex mkr mkk =
 		Just b -> case Types.Backend.verifyKeyContent b of
 			Nothing -> return True
 			Just verifier -> verifier k (serializeKey' k)
-	get r k = getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k $ \dest ->
+	get r k = getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k (AssociatedFile Nothing) $ \dest ->
 		tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) (fromRawFilePath dest) nullMeterUpdate) >>= \case
 			Right v -> return (True, v)
 			Left _ -> return (False, UnVerified)
@@ -368,13 +368,13 @@ testUnavailable runannex mkr mkk =
 	, check (`notElem` [Right True, Right False]) "checkPresent" $ \r k ->
 		Remote.checkPresent r k
 	, check (== Right False) "retrieveKeyFile" $ \r k ->
-		getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k $ \dest ->
+		getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k (AssociatedFile Nothing) $ \dest ->
 			tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) (fromRawFilePath dest) nullMeterUpdate) >>= \case
 				Right v -> return (True, v)
 				Left _ -> return (False, UnVerified)
 	, check (== Right False) "retrieveKeyFileCheap" $ \r k -> case Remote.retrieveKeyFileCheap r of
 		Nothing -> return False
-		Just a -> getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k $ \dest -> 
+		Just a -> getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k (AssociatedFile Nothing) $ \dest -> 
 			unVerified $ isRight
 				<$> tryNonAsync (a k (AssociatedFile Nothing) (fromRawFilePath dest))
 	]
@@ -436,7 +436,7 @@ randKey sz = withTmpFile "randkey" $ \f h -> do
 	k <- case Types.Backend.genKey Backend.Hash.testKeyBackend of
 		Just a -> a ks nullMeterUpdate
 		Nothing -> giveup "failed to generate random key (backend problem)"
-	_ <- moveAnnex k (toRawFilePath f)
+	_ <- moveAnnex k (AssociatedFile Nothing) (toRawFilePath f)
 	return k
 
 getReadonlyKey :: Remote -> FilePath -> Annex Key

Command/TransferKey.hs

@@ -63,7 +63,7 @@ toPerform key file remote = go Upload file $
 fromPerform :: Key -> AssociatedFile -> Remote -> CommandPerform
 fromPerform key file remote = go Upload file $
 	download (uuid remote) key file stdRetry $ \p ->
-		getViaTmp (retrievalSecurityPolicy remote) (RemoteVerify remote) key $ \t ->
+		getViaTmp (retrievalSecurityPolicy remote) (RemoteVerify remote) key file $ \t ->
 			tryNonAsync (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p) >>= \case
 				Right v -> return (True, v)	
 				Left e -> do

Command/TransferKeys.hs

@@ -47,7 +47,7 @@ start = do
 						return True
 		| otherwise = notifyTransfer direction file $
 			download (Remote.uuid remote) key file stdRetry $ \p ->
-				getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key $ \t -> do
+				getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key file $ \t -> do
 					r <- tryNonAsync (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p) >>= \case
 						Left e -> do
 							warning (show e)

P2P/Annex.hs

@@ -76,7 +76,7 @@ runLocal runst runner a = case a of
 		v <- tryNonAsync $ do
 			let runtransfer ti = 
 				Right <$> transfer download k af (\p ->
-					getViaTmp rsp DefaultVerify k $ \tmp ->
+					getViaTmp rsp DefaultVerify k af $ \tmp ->
 						storefile (fromRawFilePath tmp) o l getb validitycheck p ti)
 			let fallback = return $ Left $
 				ProtoFailureMessage "transfer already in progress, or unable to take transfer lock"

Remote/Git.hs

@@ -690,7 +690,7 @@ copyToRemote' repo r st@(State connpool duc _ _ _) key file meterupdate
 				copier <- mkCopier hardlink st params
 				let verify = Annex.Content.RemoteVerify r
 				let rsp = RetrievalAllKeysSecure
-				res <- Annex.Content.getViaTmp rsp verify key $ \dest ->
+				res <- Annex.Content.getViaTmp rsp verify key file $ \dest ->
 					metered (Just (combineMeterUpdate meterupdate p)) key $ \_ p' -> 
 						copier object (fromRawFilePath dest) p' (liftIO checksuccessio)
 				Annex.Content.saveState True

Types/CleanupActions.hs

@@ -16,6 +16,7 @@ data CleanupAction
 	| StopHook UUID
 	| FsckCleanup
 	| SshCachingCleanup
+	| AdjustedBranchUpdate
 	| TorrentCleanup URLString
 	| OtherTmpCleanup
 	deriving (Eq, Ord)

Types/GitConfig.hs

@@ -125,6 +125,7 @@ data GitConfig = GitConfig
 	, annexAutoUpgradeRepository :: Bool
 	, annexCommitMode :: CommitMode
 	, annexSkipUnknown :: Bool
+	, annexAdjustedBranchRefresh :: Integer
 	, coreSymlinks :: Bool
 	, coreSharedRepository :: SharedRepository
 	, receiveDenyCurrentBranch :: DenyCurrentBranch
@@ -219,6 +220,10 @@ extractGitConfig configsource r = GitConfig
 		then ManualCommit
 		else AutomaticCommit
 	, annexSkipUnknown = getbool (annexConfig "skipunknown") True
+	, annexAdjustedBranchRefresh = fromMaybe
+		-- parse as bool if it's not a number
+		(if getbool "adjustedbranchrefresh" False then 1 else 0)
+		(getmayberead (annexConfig "adjustedbranchrefresh"))
 	, coreSymlinks = getbool "core.symlinks" True
 	, coreSharedRepository = getSharedRepository r
 	, receiveDenyCurrentBranch = getDenyCurrentBranch r

Upgrade/V0.hs

@@ -19,7 +19,8 @@ upgrade = do
 	olddir <- fromRawFilePath <$> fromRepo gitAnnexDir
 	keys <- getKeysPresent0 olddir
 	forM_ keys $ \k ->
-		moveAnnex k $ toRawFilePath $ olddir </> keyFile0 k
+		moveAnnex k (AssociatedFile Nothing)
+			(toRawFilePath $ olddir </> keyFile0 k)
 
 	-- update the symlinks to the key files
 	-- No longer needed here; V1.upgrade does the same thing

Upgrade/V1.hs

@@ -80,7 +80,7 @@ moveContent = do
 		let d = parentDir f'
 		liftIO $ allowWrite d
 		liftIO $ allowWrite f'
-		_ <- moveAnnex k f'
+		_ <- moveAnnex k (AssociatedFile Nothing) f'
 		liftIO $ removeDirectory (fromRawFilePath d)
 
 updateSymlinks :: Annex ()

doc/git-annex-adjust.mdwn

@@ -82,7 +82,8 @@ and will also propagate commits back to the original branch.
   branch.
   
   To update the adjusted branch to reflect changes to content availability, 
-  run `git annex adjust --hide-missing` again.
+  run `git annex adjust --hide-missing` again. Or, to automate updates,
+  set the `annex.adjustedbranchrefresh` config.
 
   Despite missing files being hidden, `git annex sync --content` will
   still operate on them, and can be used to download missing
@@ -104,7 +105,8 @@ and will also propagate commits back to the original branch.
   not be broken symlinks.
   
   To update the adjusted branch to reflect changes to content availability, 
-  run `git annex adjust --unlock-present` again. Or use `git-annex sync
+  run `git annex adjust --unlock-present` again. Or, to automate updates,
+  set the `annex.adjustedbranchrefresh` config. Or use `git-annex sync
   --content`, which updates the branch after transferring content.
 
 # SEE ALSO

doc/git-annex.mdwn

@@ -1016,6 +1016,22 @@ Like other git commands, git-annex is configured via `.git/config`.
 
   When the `--batch` option is used, this configuration is ignored.
 
+* `annex.adjustedbranchrefresh`
+
+  When [[git-annex-adjust]](1) is used to set up an adjusted branch
+  that needs to be refreshed after getting or dropping files, this config
+  controls how frequently the branch is refreshed. 
+
+  Refreshing the branch takes some time, so doing it after every file
+  can be too slow. The default value is 0 (or false), which does not
+  refresh the branch. 1 (or true) will refresh once, after git-annex
+  has made other changes. Higher values refresh after approximately that
+  many files need to be updated. Ie, 2 refreshes after every file,
+  and 100 after every 99 files.
+
+  (If git-annex gets faster in the future, refresh rates will increase
+  proportional to the speed improvements.)
+
 * `annex.queuesize`
 
   git-annex builds a queue of git commands, in order to combine similar

doc/todo/update_adjusted_branch_on_content_availability_change.mdwn

@@ -10,6 +10,18 @@ it makes sense to do that? And for that matter, can it be done efficiently
 enough to do it more frequently? After every file or after some number of
 files, or after processing all files in a (sub-)tree?
 
+> Since the answer to that will change over time, let's make a config for
+> it. annex.adjustedbranchrefresh
+> 
+> The config can start out as a range from 0 up that indicates how
+> infrequently to update the branch for this. With 0 being never refresh,
+> 1 being refresh the minimum (once at shutdown), 2 being refresh after 
+> 1 file, 100 after every 99 files, etc.
+> If refreshing gets twice as fast, divide the numbers by two, etc.
+> If it becomes sufficiently fast that the overhead doesn't matter,
+> it can change to a simple boolean. Since 0 is false and > 0 is true,
+> in git config, the old values will still work. (done)
+
 Investigation of the obvious things that make it slow follows:
 
 ## efficient branch adjustment

git-annex.cabal

@@ -609,6 +609,7 @@ Executable git-annex
     Annex
     Annex.Action
     Annex.AdjustedBranch
+    Annex.AdjustedBranch.Merge
     Annex.AdjustedBranch.Name
     Annex.AutoMerge
     Annex.BloomFilter