completely solve catKey memory leak

Since 4aaa584eb632a981f5364c844f9293d4cdedaa65 was incomplete, not being
able to get the right mode of the file when the index differs from HEAD,
this is a final workaround. Only buffering the start of the file
in this case avoids leaking memory.

This does not prevent git-cat-file being asked to output the whole file,
which needs to be consumed, and can be slow. But this only happens in a
rare edge case.

1 files changed, 16 insertions, 6 deletions

diff --git a/Annex/CatFile.hs b/Annex/CatFile.hs
index c8be04b02..fa73d8282 100644
--- a/Annex/CatFile.hs
+++ b/Annex/CatFile.hs
@@ -68,13 +68,23 @@ catFileHandle = do
  - Requires a mode witness, to guarantee that the file is a symlink.
  -}
 catKey :: Ref -> FileMode -> Annex (Maybe Key)
-catKey ref mode
+catKey = catKey' True
+
+catKey' :: Bool -> Ref -> FileMode -> Annex (Maybe Key)
+catKey' modeguaranteed ref mode
 	| isSymLink mode = do
-		l <- fromInternalGitPath . encodeW8 . L.unpack <$> catObject ref
+		l <- fromInternalGitPath . encodeW8 . L.unpack <$> get
 		return $ if isLinkToAnnex l
 			then fileKey $ takeFileName l
 			else Nothing
 	| otherwise = return Nothing
+  where
+  	-- If the mode is not guaranteed to be correct, avoid
+	-- buffering the whole file content, which might be large.
+	-- 8192 is enough if it really is a symlink.
+  	get
+		| modeguaranteed = catObject ref
+		| otherwise = L.take 8192 <$> catObject ref
 
 {- Looks up the file mode corresponding to the Ref using the running
  - cat-file.
@@ -82,13 +92,13 @@ catKey ref mode
  - Currently this always has to look in HEAD, because cat-file --batch
  - does not offer a way to specify that we want to look up a tree object
  - in the index. So if the index has a file staged not as a symlink,
- - and it is a sylink in head, the wrong mode is gotten. This is a bug.
+ - and it is a symlink in head, the wrong mode is gotten.
  - Also, we have to assume the file is a symlink if it's not yet committed
- - to HEAD.
+ - to HEAD. For these reasons, modeguaranteed is not set.
  -}
 catKeyChecked :: Bool -> Ref -> Annex (Maybe Key)
-catKeyChecked needhead ref@(Ref r) = 
-	catKey ref =<< findmode <$> catTree treeref
+catKeyChecked needhead ref@(Ref r) =
+	catKey' False ref =<< findmode <$> catTree treeref
   where
   	pathparts = split "/" r
 	dir = intercalate "/" $ take (length pathparts - 1) pathparts