Merge branch 'forget'

Conflicts:
	debian/changelog
This commit is contained in:
Joey Hess 2013-09-03 14:36:00 -04:00
commit db83cc82d6
26 changed files with 685 additions and 214 deletions

View file

@ -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

View 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

View file

@ -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