pre-commit: Block partial commit of unlocked annexed file, since that left a typechange staged in index

I had hoped that the git devs could change git's handling of partial
commits to not use a false index file, but seems not.

So, this relies on some git internals to detect that case. The test suite
has a test case added to catch it if changes to git break it.

This commit was sponsored by Paul Tagliamonte.

CmdLine/Seek.hs

@@ -107,9 +107,11 @@ withFilesUnlocked' :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> (F
 withFilesUnlocked' typechanged a params = seekActions $
 	prepFiltered a unlockedfiles
   where
-	check f = liftIO (notSymlink f) <&&> 
-		(isJust <$> catKeyFile f <||> isJust <$> catKeyFileHEAD f)
-	unlockedfiles = filterM check =<< seekHelper typechanged params
+	unlockedfiles = filterM isUnlocked =<< seekHelper typechanged params
+
+isUnlocked :: FilePath -> Annex Bool
+isUnlocked f = liftIO (notSymlink f) <&&> 
+	(isJust <$> catKeyFile f <||> isJust <$> catKeyFileHEAD f)
 
 {- Finds files that may be modified. -}
 withFilesMaybeModified :: (FilePath -> CommandStart) -> CommandSeek

Command/PreCommit.hs

@@ -23,6 +23,8 @@ import Logs.View
 import Logs.MetaData
 import Types.View
 import Types.MetaData
+import qualified Git.Index as Git
+import qualified Git.LsFiles as Git
 
 import qualified Data.Set as S
 
@@ -37,10 +39,18 @@ seek ps = lockPreCommitHook $ ifM isDirect
 		withWords startDirect ps
 		runAnnexHook preCommitAnnexHook
 	, do
-		-- fix symlinks to files being committed
-		withFilesToBeCommitted (whenAnnexed Command.Fix.start) ps
-		-- inject unlocked files into the annex
-		withFilesUnlockedToBeCommitted startIndirect ps
+		ifM (liftIO Git.haveFalseIndex)
+			( do
+				(fs, cleanup) <- inRepo $ Git.typeChangedStaged ps
+				whenM (anyM isUnlocked fs) $
+					error "Cannot make a partial commit with unlocked annexed files. You should `git annex add` the files you want to commit, and then run git commit."
+				void $ liftIO cleanup
+			, do
+				-- fix symlinks to files being committed
+				withFilesToBeCommitted (whenAnnexed Command.Fix.start) ps
+				-- inject unlocked files into the annex
+				withFilesUnlockedToBeCommitted startIndirect ps
+			)
 		runAnnexHook preCommitAnnexHook
 		-- committing changes to a view updates metadata
 		mv <- currentView

Git/Index.hs

@@ -11,6 +11,9 @@ import Common
 import Git
 import Utility.Env
 
+indexEnv :: String
+indexEnv = "GIT_INDEX_FILE"
+
 {- Forces git to use the specified index file.
  -
  - Returns an action that will reset back to the default
@@ -25,7 +28,7 @@ override index = do
 	return $ reset res
   where
 	var = "GIT_INDEX_FILE"
-	reset (Just v) = setEnv var v True
+	reset (Just v) = setEnv indexEnv v True
 	reset _ = unsetEnv var
 
 indexFile :: Repo -> FilePath
@@ -34,3 +37,19 @@ indexFile r = localGitDir r </> "index"
 {- Git locks the index by creating this file. -}
 indexFileLock :: Repo -> FilePath
 indexFileLock r = indexFile r ++ ".lock"
+
+{- When the pre-commit hook is run, and git commit has been run with
+ - a file or files specified to commit, rather than committing the staged
+ - index, git provides the pre-commit hook with a "false index file".
+ -
+ - Changes made to this index will influence the commit, but won't
+ - affect the real index file.
+ -
+ - This detects when we're in this situation, using a heiristic, which
+ - might be broken by changes to git. Any use of this should have a test
+ - case to make sure it works.
+ -}
+haveFalseIndex :: IO Bool
+haveFalseIndex = maybe (False) check <$> getEnv indexEnv
+  where
+	check f = "next-index" `isPrefixOf` takeFileName f

Test.hs

@@ -194,6 +194,7 @@ unitTests note gettestenv = testGroup ("Unit Tests " ++ note)
 	, check "lock" test_lock
 	, check "edit (no pre-commit)" test_edit
 	, check "edit (pre-commit)" test_edit_precommit
+	, check "partial commit" test_partial_commit
 	, check "fix" test_fix
 	, check "trust" test_trust
 	, check "fsck (basics)" test_fsck_basic
@@ -502,6 +503,14 @@ test_edit' precommit testenv = intmpclonerepoInDirect testenv $ do
 	assertEqual "content of modified file" c (changedcontent annexedfile)
 	not <$> git_annex testenv "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of modified file"
 
+test_partial_commit :: TestEnv -> Assertion
+test_partial_commit testenv = intmpclonerepoInDirect testenv $ do
+	git_annex testenv "get" [annexedfile] @? "get of file failed"
+	annexed_present annexedfile
+	git_annex testenv "unlock" [annexedfile] @? "unlock failed"
+	not <$> boolSystem "git" [Params "commit -q -m test", File annexedfile]
+		@? "partial commit of unlocked file not blocked by pre-commit hook"
+
 test_fix :: TestEnv -> Assertion
 test_fix testenv = intmpclonerepoInDirect testenv $ do
 	annexed_notpresent annexedfile

debian/changelog

@@ -1,3 +1,11 @@
+git-annex (5.20141126) UNRELEASED; urgency=medium
+
+  * pre-commit: Block partial commit of unlocked annexed file, since
+    that left a typechange staged in index due to some infelicity of git's
+    handling of partial commits.
+
+ -- Joey Hess <joeyh@debian.org>  Mon, 10 Nov 2014 15:31:55 -0400
+
 git-annex (5.20141125) unstable; urgency=medium
 
   * Remove fixup code for bad bare repositories created by

doc/bugs/modified_permissions_persist_after_unlock__44___commit.mdwn

@@ -38,3 +38,6 @@ git version 1.7.9.5
 
 [[!tag confirmed]]
 [[!meta title="git commit of unlocked file leaves typechange staged in index"]]
+
+> [[fixed|done]]; git-annex pre-commit will block such commits from being
+> made. Git devs didn't seem to have a way to improve its behavior. --[[Joey]]