summaryrefslogtreecommitdiff
path: root/Annex
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-09-03 14:36:00 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-09-03 14:36:00 -0400
commit4e7315d991fb208ba77aba514ddf5f53a65f928b (patch)
treeccc37dc5661bb66baa5192038666dccc4eade77e /Annex
parentf180e741eda5ac16558e481c1e85faec647f8f07 (diff)
parent2afb4de6c02a4515f8b1bf6e24a32cbde7eae5a8 (diff)
Merge branch 'forget'
Conflicts: debian/changelog
Diffstat (limited to 'Annex')
-rw-r--r--Annex/Branch.hs181
-rw-r--r--Annex/Branch/Transitions.hs53
-rw-r--r--Annex/TaggedPush.hs6
3 files changed, 220 insertions, 20 deletions
diff --git a/Annex/Branch.hs b/Annex/Branch.hs
index bc3736a9a..9ee281de9 100644
--- a/Annex/Branch.hs
+++ b/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
diff --git a/Annex/Branch/Transitions.hs b/Annex/Branch/Transitions.hs
new file mode 100644
index 000000000..90002de62
--- /dev/null
+++ b/Annex/Branch/Transitions.hs
@@ -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
diff --git a/Annex/TaggedPush.hs b/Annex/TaggedPush.hs
index 44a1a0eb0..039dc0e17 100644
--- a/Annex/TaggedPush.hs
+++ b/Annex/TaggedPush.hs
@@ -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