diff options
| -rw-r--r-- | Annex/Branch.hs | 6 | ||||
| -rw-r--r-- | Annex/Direct.hs | 24 | ||||
| -rw-r--r-- | Assistant/Threads/Committer.hs | 29 | ||||
| -rw-r--r-- | Command/PreCommit.hs | 24 | ||||
| -rw-r--r-- | Command/Sync.hs | 32 | ||||
| -rw-r--r-- | Git/Branch.hs | 36 | ||||
| -rw-r--r-- | Git/Ref.hs | 6 | ||||
| -rw-r--r-- | debian/changelog | 7 | ||||
| -rw-r--r-- | doc/bugs/direct_mode_sync_should_avoid_git_commit.mdwn | 2 |
9 files changed, 94 insertions, 72 deletions
diff --git a/Annex/Branch.hs b/Annex/Branch.hs index 9838af25f..658ad731f 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -95,7 +95,7 @@ getBranch = maybe (hasOrigin >>= go >>= use) return =<< branchsha fromMaybe (error $ "failed to create " ++ show name) <$> branchsha go False = withIndex' True $ - inRepo $ Git.Branch.commit "branch created" fullname [] + inRepo $ Git.Branch.commitAlways "branch created" fullname [] use sha = do setIndexSha sha return sha @@ -249,7 +249,7 @@ commitIndex jl branchref message parents = do commitIndex' :: JournalLocked -> Git.Ref -> String -> [Git.Ref] -> Annex () commitIndex' jl branchref message parents = do updateIndex jl branchref - committedref <- inRepo $ Git.Branch.commit message fullname parents + committedref <- inRepo $ Git.Branch.commitAlways message fullname parents setIndexSha committedref parentrefs <- commitparents <$> catObject committedref when (racedetected branchref parentrefs) $ do @@ -486,7 +486,7 @@ performTransitionsLocked jl ts neednewlocalbranch transitionedrefs = do Annex.Queue.flush if neednewlocalbranch then do - committedref <- inRepo $ Git.Branch.commit message fullname transitionedrefs + committedref <- inRepo $ Git.Branch.commitAlways message fullname transitionedrefs setIndexSha committedref else do ref <- getBranch diff --git a/Annex/Direct.hs b/Annex/Direct.hs index 3fa5f9362..1034e6547 100644 --- a/Annex/Direct.hs +++ b/Annex/Direct.hs @@ -1,6 +1,6 @@ {- git-annex direct mode - - - Copyright 2012 Joey Hess <joey@kitenet.net> + - Copyright 2012, 2013 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} @@ -88,7 +88,27 @@ stageDirect = do addgit file = Annex.Queue.addCommand "add" [Param "-f"] [file] - deletegit file = Annex.Queue.addCommand "rm" [Param "-f"] [file] + deletegit file = Annex.Queue.addCommand "rm" [Param "-qf"] [file] + +{- Run before a commit to update direct mode bookeeping to reflect the + - staged changes being committed. -} +preCommitDirect :: Annex Bool +preCommitDirect = do + (diffs, clean) <- inRepo $ DiffTree.diffIndex Git.Ref.headRef + makeabs <- flip fromTopFilePath <$> gitRepo + forM_ diffs (go makeabs) + liftIO clean + where + go makeabs diff = do + withkey (DiffTree.srcsha diff) (DiffTree.srcmode diff) removeAssociatedFile + withkey (DiffTree.dstsha diff) (DiffTree.dstmode diff) addAssociatedFile + where + withkey sha mode a = when (sha /= nullSha) $ do + k <- catKey sha mode + case k of + Nothing -> noop + Just key -> void $ a key $ + makeabs $ DiffTree.file diff {- Adds a file to the annex in direct mode. Can fail, if the file is - modified or deleted while it's being added. -} diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs index 695703e22..bebe6f634 100644 --- a/Assistant/Threads/Committer.hs +++ b/Assistant/Threads/Committer.hs @@ -20,9 +20,7 @@ import Assistant.Drop import Logs.Transfer import Logs.Location import qualified Annex.Queue -import qualified Git.Command import qualified Git.LsFiles -import qualified Git.BuildVersion import qualified Command.Add import Utility.ThreadScheduler import qualified Utility.Lsof as Lsof @@ -36,6 +34,7 @@ import Annex.CatFile import qualified Annex import Utility.InodeCache import Annex.Content.Direct +import qualified Command.Sync import Data.Time.Clock import Data.Tuple.Utils @@ -217,31 +216,7 @@ commitStaged = do v <- tryAnnex Annex.Queue.flush case v of Left _ -> return False - Right _ -> do - {- Empty commits may be made if tree changes cancel - - each other out, etc. Git returns nonzero on those, - - so don't propigate out commit failures. -} - void $ inRepo $ catchMaybeIO . - Git.Command.runQuiet - (Param "commit" : nomessage params) - return True - where - params = - [ Param "--quiet" - {- Avoid running the usual pre-commit hook; - - the Watcher does the same symlink fixing, - - and direct mode bookkeeping updating. -} - , Param "--no-verify" - ] - nomessage ps - | Git.BuildVersion.older "1.7.2" = - Param "-m" : Param "autocommit" : ps - | Git.BuildVersion.older "1.7.8" = - Param "--allow-empty-message" : - Param "-m" : Param "" : ps - | otherwise = - Param "--allow-empty-message" : - Param "--no-edit" : Param "-m" : Param "" : ps + Right _ -> Command.Sync.commitStaged "" {- OSX needs a short delay after a file is added before locking it down, - when using a non-direct mode repository, as pasting a file seems to diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs index f10ac628e..eed2f491c 100644 --- a/Command/PreCommit.hs +++ b/Command/PreCommit.hs @@ -11,12 +11,7 @@ import Common.Annex import Command import qualified Command.Add import qualified Command.Fix -import qualified Git.DiffTree -import qualified Git.Ref -import Annex.CatFile -import Annex.Content.Direct -import Git.Sha -import Git.FilePath +import Annex.Direct def :: [Command] def = [command "pre-commit" paramPaths seek SectionPlumbing @@ -39,19 +34,4 @@ startIndirect file = next $ do next $ return True startDirect :: [String] -> CommandStart -startDirect _ = next $ do - (diffs, clean) <- inRepo $ Git.DiffTree.diffIndex Git.Ref.headRef - makeabs <- flip fromTopFilePath <$> gitRepo - forM_ diffs (go makeabs) - next $ liftIO clean - where - go makeabs diff = do - withkey (Git.DiffTree.srcsha diff) (Git.DiffTree.srcmode diff) removeAssociatedFile - withkey (Git.DiffTree.dstsha diff) (Git.DiffTree.dstmode diff) addAssociatedFile - where - withkey sha mode a = when (sha /= nullSha) $ do - k <- catKey sha mode - case k of - Nothing -> noop - Just key -> void $ a key $ - makeabs $ Git.DiffTree.file diff +startDirect _ = next $ next $ preCommitDirect diff --git a/Command/Sync.hs b/Command/Sync.hs index c41f46f8a..14c79e99d 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -103,19 +103,33 @@ syncRemotes rs = ifM (Annex.getState Annex.fast) ( nub <$> pickfast , wanted ) commit :: CommandStart commit = next $ next $ ifM isDirect ( do + showStart "commit" "" void stageDirect - runcommit [] - , runcommit [Param "-a"] - ) - where - runcommit ps = do + void preCommitDirect + commitStaged commitmessage + , do showStart "commit" "" - showOutput Annex.Branch.commit "update" -- Commit will fail when the tree is clean, so ignore failure. - let params = Param "commit" : ps ++ - [Param "-m", Param "git-annex automatic sync"] - _ <- inRepo $ tryIO . Git.Command.runQuiet params + _ <- inRepo $ tryIO . Git.Command.runQuiet + [ Param "commit" + , Param "-a" + , Param "-m" + , Param commitmessage + ] + return True + ) + where + commitmessage = "git-annex automatic sync" + +commitStaged :: String -> Annex Bool +commitStaged commitmessage = go =<< inRepo Git.Branch.currentUnsafe + where + go Nothing = return False + go (Just branch) = do + parent <- inRepo $ Git.Ref.sha branch + void $ inRepo $ Git.Branch.commit False commitmessage branch + (maybe [] (:[]) parent) return True mergeLocal :: Maybe Git.Ref -> CommandStart diff --git a/Git/Branch.hs b/Git/Branch.hs index 7b3297d74..405fa108f 100644 --- a/Git/Branch.hs +++ b/Git/Branch.hs @@ -89,18 +89,38 @@ fastForward branch (first:rest) repo = (False, False) -> findbest c rs -- same {- Commits the index into the specified branch (or other ref), - - with the specified parent refs, and returns the committed sha -} -commit :: String -> Branch -> [Ref] -> Repo -> IO Sha -commit message branch parentrefs repo = do + - with the specified parent refs, and returns the committed sha. + - + - Without allowempy set, avoids making a commit if there is exactly + - one parent, and it has the same tree that would be committed. + - + - Unlike git-commit, does not run any hooks, or examine the work tree + - in any way. + -} +commit :: Bool -> String -> Branch -> [Ref] -> Repo -> IO (Maybe Sha) +commit allowempty message branch parentrefs repo = do tree <- getSha "write-tree" $ pipeReadStrict [Param "write-tree"] repo - sha <- getSha "commit-tree" $ pipeWriteRead - (map Param $ ["commit-tree", show tree] ++ ps) - (Just $ flip hPutStr message) repo - update branch sha repo - return sha + ifM (cancommit tree) + ( do + sha <- getSha "commit-tree" $ pipeWriteRead + (map Param $ ["commit-tree", show tree] ++ ps) + (Just $ flip hPutStr message) repo + update branch sha repo + return $ Just sha + , return Nothing + ) where ps = concatMap (\r -> ["-p", show r]) parentrefs + cancommit tree + | allowempty = return True + | otherwise = case parentrefs of + [p] -> maybe False (tree /=) <$> Git.Ref.tree p repo + _ -> return True + +commitAlways :: String -> Branch -> [Ref] -> Repo -> IO Sha +commitAlways message branch parentrefs repo = fromJust + <$> commit True message branch parentrefs repo {- A leading + makes git-push force pushing a branch. -} forcePush :: String -> String diff --git a/Git/Ref.hs b/Git/Ref.hs index 6ce1b8784..09472930f 100644 --- a/Git/Ref.hs +++ b/Git/Ref.hs @@ -10,6 +10,7 @@ module Git.Ref where import Common import Git import Git.Command +import Git.Sha import Data.Char (chr) @@ -105,6 +106,11 @@ matchingUniq refs repo = nubBy uniqref <$> matching refs repo where uniqref (a, _) (b, _) = a == b +{- Gets the sha of the tree a ref uses. -} +tree :: Ref -> Repo -> IO (Maybe Sha) +tree ref = extractSha <$$> pipeReadStrict + [ Param "rev-parse", Param (show ref ++ ":") ] + {- Checks if a String is a legal git ref name. - - The rules for this are complex; see git-check-ref-format(1) -} diff --git a/debian/changelog b/debian/changelog index be97830a7..12bde5dfa 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,10 @@ +git-annex (5.20131131) UNRELEASED; urgency=low + + * Avoid using git commit in direct mode, since in some situations + it will read the full contents of files in the tree. + + -- Joey Hess <joeyh@debian.org> Sun, 01 Dec 2013 13:57:58 -0400 + git-annex (5.20131130) unstable; urgency=low * init: Fix a bug that caused git annex init, when run in a bare diff --git a/doc/bugs/direct_mode_sync_should_avoid_git_commit.mdwn b/doc/bugs/direct_mode_sync_should_avoid_git_commit.mdwn index ed4bb8f47..498c4d000 100644 --- a/doc/bugs/direct_mode_sync_should_avoid_git_commit.mdwn +++ b/doc/bugs/direct_mode_sync_should_avoid_git_commit.mdwn @@ -2,4 +2,4 @@ Per forum post linking to this bug, git commit can be very slow when run in a fi So, git annex sync should stop using git commit when in direct mode, and instead manually make its own commit. Git.Branch.commit and Git.Branch.update should be able to easily be used for this. -PS: this page was created elsewhere, and therefore not listed in bugs page +> [[done]] --[[Joey]] |