Avoid using git commit in direct mode, since in some situations it will read the full contents of files in the tree.

The assistant's commit code also always avoids git commit, for simplicity.
Indirect mode sync still does a git commit -a to catch unstaged changes.

Note that this means that direct mode sync no longer runs the pre-commit
hook or any other hooks git commit might call. The git annex pre-commit
hook action for direct mode is however explicitly run. (The assistant
already ran git commit with hooks disabled, so no change there.)

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

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. -}

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

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

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
-		void stageDirect
-		runcommit []
-	, runcommit [Param "-a"]
-	)
-  where
-	runcommit ps = do
 		showStart "commit" ""
-		showOutput
+		void stageDirect
+		void preCommitDirect
+		commitStaged commitmessage
+	, do
+		showStart "commit" ""
 		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

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

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) -}

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

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