, 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
, sentinalstatus = Nothing
, useragent = Nothing
, errcounter = 0
+ , adjustedbranchrefreshcounter = 0
, unusedkeys = Nothing
, tempurls = M.empty
, existinghooks = M.empty
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]
getAdjustment,
enterAdjustedBranch,
updateAdjustedBranch,
+ adjustedBranchRefresh,
adjustBranch,
+ adjustTree,
adjustToCrippledFileSystem,
- mergeToAdjustedBranch,
propigateAdjustedCommits,
+ propigateAdjustedCommits',
+ commitAdjustedTree,
+ commitAdjustedTree',
+ BasisBranch(..),
+ basisBranch,
+ setBasisBranch,
+ preventCommits,
AdjustedClone(..),
checkAdjustedClone,
checkVersionSupported,
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
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.
-- 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."
[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.
--- /dev/null
+{- 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
import Annex.LockPool
import Annex.UUID
import Annex.InodeSentinal
+import Annex.AdjustedBranch (adjustedBranchRefresh)
import Messages.Progress
import Types.Remote (RetrievalSecurityPolicy(..))
import Types.NumCopies
{- 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
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
- 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
where
storeobject dest = ifM (liftIO $ R.doesPathExist dest)
( alreadyhave
- , modifyContent dest $ do
+ , adjustedBranchRefresh af $ modifyContent dest $ do
freezeContent src
liftIO $ moveFile
(fromRawFilePath src)
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
-- 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
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))
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
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
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
)
, 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
* 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.
| 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
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
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
- 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
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
)
where
move = checkDiskSpaceToGet key False $
- moveAnnex key src
+ moveAnnex key (AssociatedFile Nothing) src
cleanup :: Key -> CommandCleanup
cleanup 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)
import Logs.PreferredContent
import Annex.AutoMerge
import Annex.AdjustedBranch
+import Annex.AdjustedBranch.Merge
import Annex.Ssh
import Annex.BloomFilter
import Annex.UpdateInstead
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)
, 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))
]
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
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
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)
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"
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
| StopHook UUID
| FsckCleanup
| SshCachingCleanup
+ | AdjustedBranchUpdate
| TorrentCleanup URLString
| OtherTmpCleanup
deriving (Eq, Ord)
, annexAutoUpgradeRepository :: Bool
, annexCommitMode :: CommitMode
, annexSkipUnknown :: Bool
+ , annexAdjustedBranchRefresh :: Integer
, coreSymlinks :: Bool
, coreSharedRepository :: SharedRepository
, receiveDenyCurrentBranch :: DenyCurrentBranch
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
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
let d = parentDir f'
liftIO $ allowWrite d
liftIO $ allowWrite f'
- _ <- moveAnnex k f'
+ _ <- moveAnnex k (AssociatedFile Nothing) f'
liftIO $ removeDirectory (fromRawFilePath d)
updateSymlinks :: Annex ()
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
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
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
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
Annex
Annex.Action
Annex.AdjustedBranch
+ Annex.AdjustedBranch.Merge
Annex.AdjustedBranch.Name
Annex.AutoMerge
Annex.BloomFilter
projects / git-annex.git / commitdiff