summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Annex/Branch.hs112
-rw-r--r--Locations.hs5
-rw-r--r--Logs/Transitions.hs30
-rw-r--r--doc/git-annex.mdwn18
4 files changed, 142 insertions, 23 deletions
diff --git a/Annex/Branch.hs b/Annex/Branch.hs
index bc3736a9a..fa4b0265d 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,8 @@ import Annex.CatFile
import Annex.Perms
import qualified Annex
import Utility.Env
+import Logs.Transitions
+import Annex.ReplaceFile
{- Name of the branch that is used to store git-annex's information. -}
name :: Git.Ref
@@ -110,6 +116,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 +126,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 +142,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,16 +152,23 @@ 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
@@ -361,3 +380,76 @@ 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 = withIndex $ do
+ when (inTransitions ForgetDeadRemotes ts) $
+ error "TODO ForgetDeadRemotes transition"
+ 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
diff --git a/Locations.hs b/Locations.hs
index 1cbbb9886..7762afb64 100644
--- a/Locations.hs
+++ b/Locations.hs
@@ -35,6 +35,7 @@ module Locations (
gitAnnexJournalLock,
gitAnnexIndex,
gitAnnexIndexLock,
+ gitAnnexIgnoredRefs,
gitAnnexPidFile,
gitAnnexDaemonStatusFile,
gitAnnexLogFile,
@@ -225,6 +226,10 @@ gitAnnexIndex r = gitAnnexDir r </> "index"
gitAnnexIndexLock :: Git.Repo -> FilePath
gitAnnexIndexLock r = gitAnnexDir r </> "index.lck"
+{- List of refs that should not be merged into the git-annex branch. -}
+gitAnnexIgnoredRefs :: Git.Repo -> FilePath
+gitAnnexIgnoredRefs r = gitAnnexDir r </> "ignoredrefs"
+
{- Pid file for daemon mode. -}
gitAnnexPidFile :: Git.Repo -> FilePath
gitAnnexPidFile r = gitAnnexDir r </> "daemon.pid"
diff --git a/Logs/Transitions.hs b/Logs/Transitions.hs
index e548a2f23..41f4b2635 100644
--- a/Logs/Transitions.hs
+++ b/Logs/Transitions.hs
@@ -46,6 +46,10 @@ data TransitionLine = TransitionLine
type Transitions = S.Set TransitionLine
+describeTransition :: Transition -> String
+describeTransition ForgetGitHistory = "forget git history"
+describeTransition ForgetDeadRemotes = "forget dead remotes"
+
addTransition :: POSIXTime -> Transition -> Transitions -> Transitions
addTransition ts t = S.insert $ TransitionLine ts t
@@ -60,6 +64,11 @@ parseTransitions = check . map parseTransitionLine . lines
| all isJust l = Just $ S.fromList $ catMaybes l
| otherwise = Nothing
+parseTransitionsStrictly :: String -> String -> Transitions
+parseTransitionsStrictly source = fromMaybe badsource . parseTransitions
+ where
+ badsource = error $ "unknown transitions listed in " ++ source ++ "; upgrade git-annex!"
+
showTransitionLine :: TransitionLine -> String
showTransitionLine (TransitionLine ts t) = unwords [show t, show ts]
@@ -71,17 +80,14 @@ parseTransitionLine s = TransitionLine <$> pdate ds <*> readish ts
ds = unwords $ Prelude.tail ws
pdate = parseTime defaultTimeLocale "%s%Qs" >=*> utcTimeToPOSIXSeconds
-{- Compares two sets of transitions, and returns a list of any transitions
- - from the second set that have not yet been perfomed in the first,
- - and a list of any transitions from the first set that have not yet been
- - performed in the second. -}
-diffTransitions :: Transitions -> Transitions -> ([Transition], [Transition])
-diffTransitions a b = (b `diff` a, a `diff` b)
- where
- diff x y = map transition $ S.elems $ S.difference x y
+combineTransitions :: [Transitions] -> Transitions
+combineTransitions = S.unions
+
+inTransitions :: Transition -> Transitions -> Bool
+inTransitions t = not . S.null . S.filter (\l -> transition l == t)
-sameTransitions :: Transitions -> Transitions -> Bool
-sameTransitions a b = let (x, y) = diffTransitions a b in null x && null y
+transitionList :: Transitions -> [Transition]
+transitionList = map transition . S.elems
{- Typically ran with Annex.Branch.change, but we can't import Annex.Branch
- here since it depends on this module. -}
@@ -89,6 +95,4 @@ recordTransition :: (FilePath -> (String -> String) -> Annex ()) -> Transition -
recordTransition changer o = do
t <- liftIO getPOSIXTime
changer transitionsLog $
- showTransitions . addTransition t o . fromMaybe badlog . parseTransitions
- where
- badlog = error $ "unknown transitions exist in " ++ transitionsLog
+ showTransitions . addTransition t o . parseTransitionsStrictly "local"
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index 7cac9087d..72e376d64 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -479,6 +479,24 @@ subdirectories).
Upgrades the repository to current layout.
+* forget
+
+ Causes the git-annex branch to be rewritten, throwing away historical
+ data about past locations of files, files that are no longer present on
+ any remote, etc. The resulting branch will use less space, but for
+ example `git annex log` will not be able to show where files used to
+ be located.
+
+ To also prune references to remotes that have been marked as dead,
+ specify --forget-dead.
+
+ When this rewritten branch is merged into other clones of
+ the repository, git-annex will automatically perform the same rewriting
+ to their local git-annex branch. So the forgetfulness will automatically
+ propigate out from its starting point until all repositories running
+ git-annex have forgotten their old history. (You may need to force
+ git to push the branch to any git repositories not running git-annex.
+
# QUERY COMMANDS
* version