Merge branch 'forget'
Conflicts: debian/changelog
This commit is contained in:
commit
db83cc82d6
26 changed files with 685 additions and 214 deletions
181
Annex/Branch.hs
181
Annex/Branch.hs
|
@ -1,6 +1,6 @@
|
|||
{- management of the git-annex branch
|
||||
-
|
||||
- Copyright 2011-2012 Joey Hess <joey@kitenet.net>
|
||||
- Copyright 2011-2013 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
@ -22,9 +22,12 @@ module Annex.Branch (
|
|||
commit,
|
||||
files,
|
||||
withIndex,
|
||||
performTransitions,
|
||||
) where
|
||||
|
||||
import qualified Data.ByteString.Lazy.Char8 as L
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.Map as M
|
||||
|
||||
import Common.Annex
|
||||
import Annex.BranchState
|
||||
|
@ -32,6 +35,7 @@ import Annex.Journal
|
|||
import qualified Git
|
||||
import qualified Git.Command
|
||||
import qualified Git.Ref
|
||||
import qualified Git.Sha
|
||||
import qualified Git.Branch
|
||||
import qualified Git.UnionMerge
|
||||
import qualified Git.UpdateIndex
|
||||
|
@ -42,6 +46,12 @@ import Annex.CatFile
|
|||
import Annex.Perms
|
||||
import qualified Annex
|
||||
import Utility.Env
|
||||
import Logs
|
||||
import Logs.Transitions
|
||||
import Logs.Trust.Pure
|
||||
import Annex.ReplaceFile
|
||||
import qualified Annex.Queue
|
||||
import Annex.Branch.Transitions
|
||||
|
||||
{- Name of the branch that is used to store git-annex's information. -}
|
||||
name :: Git.Ref
|
||||
|
@ -110,6 +120,9 @@ forceUpdate = updateTo =<< siblingBranches
|
|||
- later get staged, and might overwrite changes made during the merge.
|
||||
- This is only done if some of the Refs do need to be merged.
|
||||
-
|
||||
- Also handles performing any Transitions that have not yet been
|
||||
- performed, in either the local branch, or the Refs.
|
||||
-
|
||||
- Returns True if any refs were merged in, False otherwise.
|
||||
-}
|
||||
updateTo :: [(Git.Ref, Git.Branch)] -> Annex Bool
|
||||
|
@ -117,7 +130,8 @@ updateTo pairs = do
|
|||
-- ensure branch exists, and get its current ref
|
||||
branchref <- getBranch
|
||||
dirty <- journalDirty
|
||||
(refs, branches) <- unzip <$> filterM isnewer pairs
|
||||
ignoredrefs <- getIgnoredRefs
|
||||
(refs, branches) <- unzip <$> filterM (isnewer ignoredrefs) pairs
|
||||
if null refs
|
||||
{- Even when no refs need to be merged, the index
|
||||
- may still be updated if the branch has gotten ahead
|
||||
|
@ -132,7 +146,9 @@ updateTo pairs = do
|
|||
else lockJournal $ go branchref dirty refs branches
|
||||
return $ not $ null refs
|
||||
where
|
||||
isnewer (r, _) = inRepo $ Git.Branch.changed fullname r
|
||||
isnewer ignoredrefs (r, _)
|
||||
| S.member r ignoredrefs = return False
|
||||
| otherwise = inRepo $ Git.Branch.changed fullname r
|
||||
go branchref dirty refs branches = withIndex $ do
|
||||
cleanjournal <- if dirty then stageJournal else return noop
|
||||
let merge_desc = if null branches
|
||||
|
@ -140,23 +156,30 @@ updateTo pairs = do
|
|||
else "merging " ++
|
||||
unwords (map Git.Ref.describe branches) ++
|
||||
" into " ++ show name
|
||||
localtransitions <- parseTransitionsStrictly "local"
|
||||
<$> getStale transitionsLog
|
||||
unless (null branches) $ do
|
||||
showSideAction merge_desc
|
||||
mergeIndex refs
|
||||
ff <- if dirty
|
||||
then return False
|
||||
else inRepo $ Git.Branch.fastForward fullname refs
|
||||
if ff
|
||||
then updateIndex branchref
|
||||
else commitBranch branchref merge_desc
|
||||
(nub $ fullname:refs)
|
||||
let commitrefs = nub $ fullname:refs
|
||||
transitioned <- handleTransitions localtransitions commitrefs
|
||||
case transitioned of
|
||||
Nothing -> do
|
||||
ff <- if dirty
|
||||
then return False
|
||||
else inRepo $ Git.Branch.fastForward fullname refs
|
||||
if ff
|
||||
then updateIndex branchref
|
||||
else commitBranch branchref merge_desc commitrefs
|
||||
Just (branchref', commitrefs') ->
|
||||
commitBranch branchref' merge_desc commitrefs'
|
||||
liftIO cleanjournal
|
||||
|
||||
{- Gets the content of a file, which may be in the journal, or in the index
|
||||
- (and committed to the branch).
|
||||
-
|
||||
- Updates the branch if necessary, to ensure the most up-to-date available
|
||||
- content is available.
|
||||
- content is returned.
|
||||
-
|
||||
- Returns an empty string if the file doesn't exist yet. -}
|
||||
get :: FilePath -> Annex String
|
||||
|
@ -175,7 +198,10 @@ get' :: FilePath -> Annex String
|
|||
get' file = go =<< getJournalFile file
|
||||
where
|
||||
go (Just journalcontent) = return journalcontent
|
||||
go Nothing = withIndex $ L.unpack <$> catFile fullname file
|
||||
go Nothing = getRaw file
|
||||
|
||||
getRaw :: FilePath -> Annex String
|
||||
getRaw file = withIndex $ L.unpack <$> catFile fullname file
|
||||
|
||||
{- Applies a function to modifiy the content of a file.
|
||||
-
|
||||
|
@ -253,13 +279,17 @@ commitBranch' branchref message parents = do
|
|||
files :: Annex [FilePath]
|
||||
files = do
|
||||
update
|
||||
withIndex $ do
|
||||
bfiles <- inRepo $ Git.Command.pipeNullSplitZombie
|
||||
[ Params "ls-tree --name-only -r -z"
|
||||
, Param $ show fullname
|
||||
]
|
||||
jfiles <- getJournalledFiles
|
||||
return $ jfiles ++ bfiles
|
||||
(++)
|
||||
<$> branchFiles
|
||||
<*> getJournalledFiles
|
||||
|
||||
{- Files in the branch, not including any from journalled changes,
|
||||
- and without updating the branch. -}
|
||||
branchFiles :: Annex [FilePath]
|
||||
branchFiles = withIndex $ inRepo $ Git.Command.pipeNullSplitZombie
|
||||
[ Params "ls-tree --name-only -r -z"
|
||||
, Param $ show fullname
|
||||
]
|
||||
|
||||
{- Populates the branch's index file with the current branch contents.
|
||||
-
|
||||
|
@ -361,3 +391,116 @@ stageJournal = withIndex $ do
|
|||
sha <- hashFile h path
|
||||
streamer $ Git.UpdateIndex.updateIndexLine
|
||||
sha FileBlob (asTopFilePath $ fileJournal file)
|
||||
|
||||
{- This is run after the refs have been merged into the index,
|
||||
- but before the result is committed to the branch.
|
||||
- Which is why it's passed the contents of the local branches's
|
||||
- transition log before that merge took place.
|
||||
-
|
||||
- When the refs contain transitions that have not yet been done locally,
|
||||
- the transitions are performed on the index, and a new branch
|
||||
- is created from the result, and returned.
|
||||
-
|
||||
- When there are transitions recorded locally that have not been done
|
||||
- to the remote refs, the transitions are performed in the index,
|
||||
- and the existing branch is returned. In this case, the untransitioned
|
||||
- remote refs cannot be merged into the branch (since transitions
|
||||
- throw away history), so none of them are included in the returned
|
||||
- list of refs, and they are added to the list of refs to ignore,
|
||||
- to avoid re-merging content from them again.
|
||||
-}
|
||||
handleTransitions :: Transitions -> [Git.Ref] -> Annex (Maybe (Git.Branch, [Git.Ref]))
|
||||
handleTransitions localts refs = do
|
||||
m <- M.fromList <$> mapM getreftransition refs
|
||||
let remotets = M.elems m
|
||||
if all (localts ==) remotets
|
||||
then return Nothing
|
||||
else do
|
||||
let allts = combineTransitions (localts:remotets)
|
||||
let (transitionedrefs, untransitionedrefs) =
|
||||
partition (\r -> M.lookup r m == Just allts) refs
|
||||
transitionedbranch <- performTransitions allts (localts /= allts)
|
||||
ignoreRefs untransitionedrefs
|
||||
return $ Just (transitionedbranch, transitionedrefs)
|
||||
where
|
||||
getreftransition ref = do
|
||||
ts <- parseTransitionsStrictly "remote" . L.unpack
|
||||
<$> catFile ref transitionsLog
|
||||
return (ref, ts)
|
||||
|
||||
ignoreRefs :: [Git.Ref] -> Annex ()
|
||||
ignoreRefs rs = do
|
||||
old <- getIgnoredRefs
|
||||
let s = S.unions [old, S.fromList rs]
|
||||
f <- fromRepo gitAnnexIgnoredRefs
|
||||
replaceFile f $ \tmp -> liftIO $ writeFile tmp $
|
||||
unlines $ map show $ S.elems s
|
||||
|
||||
getIgnoredRefs :: Annex (S.Set Git.Ref)
|
||||
getIgnoredRefs = S.fromList . mapMaybe Git.Sha.extractSha . lines <$> content
|
||||
where
|
||||
content = do
|
||||
f <- fromRepo gitAnnexIgnoredRefs
|
||||
liftIO $ catchDefaultIO "" $ readFile f
|
||||
|
||||
{- Performs the specified transitions on the contents of the index file,
|
||||
- commits it to the branch, or creates a new branch, and returns
|
||||
- the branch's ref. -}
|
||||
performTransitions :: Transitions -> Bool -> Annex Git.Ref
|
||||
performTransitions ts neednewbranch = do
|
||||
-- For simplicity & speed, we're going to use the Annex.Queue to
|
||||
-- update the git-annex branch, while it usually holds changes
|
||||
-- for the head branch. Flush any such changes.
|
||||
Annex.Queue.flush
|
||||
withIndex $ do
|
||||
run $ mapMaybe getTransitionCalculator $ transitionList ts
|
||||
Annex.Queue.flush
|
||||
if neednewbranch
|
||||
then do
|
||||
committedref <- inRepo $ Git.Branch.commit message fullname []
|
||||
setIndexSha committedref
|
||||
return committedref
|
||||
else do
|
||||
ref <- getBranch
|
||||
commitBranch ref message [fullname]
|
||||
getBranch
|
||||
where
|
||||
message
|
||||
| neednewbranch = "new branch for transition " ++ tdesc
|
||||
| otherwise = "continuing transition " ++ tdesc
|
||||
tdesc = show $ map describeTransition $ transitionList ts
|
||||
|
||||
{- The changes to make to the branch are calculated and applied to
|
||||
- the branch directly, rather than going through the journal,
|
||||
- which would be innefficient. (And the journal is not designed
|
||||
- to hold changes to every file in the branch at once.)
|
||||
-
|
||||
- When a file in the branch is changed by transition code,
|
||||
- that value is remembered and fed into the code for subsequent
|
||||
- transitions.
|
||||
-}
|
||||
run [] = noop
|
||||
run changers = do
|
||||
trustmap <- calcTrustMap <$> getRaw trustLog
|
||||
fs <- branchFiles
|
||||
hasher <- inRepo hashObjectStart
|
||||
forM_ fs $ \f -> do
|
||||
content <- getRaw f
|
||||
apply changers hasher f content trustmap
|
||||
liftIO $ hashObjectStop hasher
|
||||
apply [] _ _ _ _ = return ()
|
||||
apply (changer:rest) hasher file content trustmap =
|
||||
case changer file content trustmap of
|
||||
RemoveFile -> do
|
||||
Annex.Queue.addUpdateIndex
|
||||
=<< inRepo (Git.UpdateIndex.unstageFile file)
|
||||
-- File is deleted; can't run any other
|
||||
-- transitions on it.
|
||||
return ()
|
||||
ChangeFile content' -> do
|
||||
sha <- inRepo $ hashObject BlobObject content'
|
||||
Annex.Queue.addUpdateIndex $ Git.UpdateIndex.pureStreamer $
|
||||
Git.UpdateIndex.updateIndexLine sha FileBlob (asTopFilePath file)
|
||||
apply rest hasher file content' trustmap
|
||||
PreserveFile ->
|
||||
apply rest hasher file content trustmap
|
||||
|
|
53
Annex/Branch/Transitions.hs
Normal file
53
Annex/Branch/Transitions.hs
Normal file
|
@ -0,0 +1,53 @@
|
|||
{- git-annex branch transitions
|
||||
-
|
||||
- Copyright 2013 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Annex.Branch.Transitions (
|
||||
FileTransition(..),
|
||||
getTransitionCalculator
|
||||
) where
|
||||
|
||||
import Logs
|
||||
import Logs.Transitions
|
||||
import Logs.UUIDBased as UUIDBased
|
||||
import Logs.Presence.Pure as Presence
|
||||
import Types.TrustLevel
|
||||
import Types.UUID
|
||||
|
||||
import qualified Data.Map as M
|
||||
|
||||
data FileTransition
|
||||
= ChangeFile String
|
||||
| RemoveFile
|
||||
| PreserveFile
|
||||
|
||||
type TransitionCalculator = FilePath -> String -> TrustMap -> FileTransition
|
||||
|
||||
getTransitionCalculator :: Transition -> Maybe TransitionCalculator
|
||||
getTransitionCalculator ForgetGitHistory = Nothing
|
||||
getTransitionCalculator ForgetDeadRemotes = Just dropDead
|
||||
|
||||
dropDead :: FilePath -> String -> TrustMap -> FileTransition
|
||||
dropDead f content trustmap = case getLogVariety f of
|
||||
Just UUIDBasedLog -> ChangeFile $
|
||||
UUIDBased.showLog id $ dropDeadFromUUIDBasedLog trustmap $ UUIDBased.parseLog Just content
|
||||
Just (PresenceLog _) ->
|
||||
let newlog = Presence.compactLog $ dropDeadFromPresenceLog trustmap $ Presence.parseLog content
|
||||
in if null newlog
|
||||
then RemoveFile
|
||||
else ChangeFile $ Presence.showLog newlog
|
||||
Nothing -> PreserveFile
|
||||
|
||||
dropDeadFromUUIDBasedLog :: TrustMap -> UUIDBased.Log String -> UUIDBased.Log String
|
||||
dropDeadFromUUIDBasedLog trustmap = M.filterWithKey $ notDead trustmap . const
|
||||
|
||||
{- Presence logs can contain UUIDs or other values. Any line that matches
|
||||
- a dead uuid is dropped; any other values are passed through. -}
|
||||
dropDeadFromPresenceLog :: TrustMap -> [Presence.LogLine] -> [Presence.LogLine]
|
||||
dropDeadFromPresenceLog trustmap = filter $ notDead trustmap (toUUID . Presence.info)
|
||||
|
||||
notDead :: TrustMap -> (v -> UUID) -> v -> Bool
|
||||
notDead trustmap a v = M.findWithDefault SemiTrusted (a v) trustmap /= DeadTrusted
|
|
@ -13,6 +13,7 @@ import qualified Annex.Branch
|
|||
import qualified Git
|
||||
import qualified Git.Ref
|
||||
import qualified Git.Command
|
||||
import qualified Git.Branch
|
||||
import Utility.Base64
|
||||
|
||||
{- Converts a git branch into a branch that is tagged with a UUID, typically
|
||||
|
@ -50,7 +51,10 @@ taggedPush :: UUID -> Maybe String -> Git.Ref -> Remote -> Git.Repo -> IO Bool
|
|||
taggedPush u info branch remote = Git.Command.runBool
|
||||
[ Param "push"
|
||||
, Param $ Remote.name remote
|
||||
, Param $ refspec Annex.Branch.name
|
||||
{- Using forcePush here is safe because we "own" the tagged branch
|
||||
- we're pushing; it has no other writers. Ensures it is pushed
|
||||
- even if it has been rewritten by a transition. -}
|
||||
, Param $ Git.Branch.forcePush $ refspec Annex.Branch.name
|
||||
, Param $ refspec branch
|
||||
]
|
||||
where
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue