Fix memory leak in last release, which affected commands like git-annex status when a large non-annexed file is present in the work tree.

The whole file was strictly read, and so buffered in memory, and remained
buffered for some time when running git-annex status.

2 files changed, 18 insertions, 12 deletions

diff --git a/Annex/Link.hs b/Annex/Link.hs
index f10cca5c8..40e56f23e 100644
--- a/Annex/Link.hs
+++ b/Annex/Link.hs
@@ -12,7 +12,7 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP, BangPatterns #-}
 
 module Annex.Link where
 
@@ -25,7 +25,7 @@ import Git.Types
 import Git.FilePath
 
 import qualified Data.ByteString.Lazy as L
-import qualified Data.ByteString as B
+import Data.Int
 
 type LinkTarget = String
 
@@ -133,15 +133,17 @@ stagePointerFile file sha =
  - Only looks at the first line, as pointer files can have subsequent
  - lines. -}
 parseLinkOrPointer :: L.ByteString -> Maybe Key
-parseLinkOrPointer = parseLinkOrPointer' . decodeBS . L.take maxsz
+parseLinkOrPointer = parseLinkOrPointer' . decodeBS . L.take maxPointerSz
   where
-	{- Want to avoid buffering really big files in git into
-	 - memory when reading files that may be pointers.
-	 -
-	 - 8192 bytes is plenty for a pointer to a key.
-	 - Pad some more to allow for any pointer files that might have
-	 - lines after the key explaining what the file is used for. -}
-	maxsz = 81920
+
+{- Want to avoid buffering really big files in git into
+ - memory when reading files that may be pointers.
+ -
+ - 8192 bytes is plenty for a pointer to a key.
+ - Pad some more to allow for any pointer files that might have
+ - lines after the key explaining what the file is used for. -}
+maxPointerSz :: Int64
+maxPointerSz = 81920
 
 parseLinkOrPointer' :: String -> Maybe Key
 parseLinkOrPointer' = go . fromInternalGitPath . takeWhile (not . lineend)
@@ -160,8 +162,9 @@ formatPointer k =
 {- Checks if a file is a pointer to a key. -}
 isPointerFile :: FilePath -> IO (Maybe Key)
 isPointerFile f = catchDefaultIO Nothing $ do
-	b <- B.readFile f
-	return $ parseLinkOrPointer $ L.fromChunks [b]
+	b <- L.take maxPointerSz <$> L.readFile f
+	let !mk = parseLinkOrPointer' (decodeBS b)
+	return mk
 
 {- Checks a symlink target or pointer file first line to see if it
  - appears to point to annexed content.
diff --git a/debian/changelog b/debian/changelog
index cb1cd7b5d..36f82b00d 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,6 +1,9 @@
 git-annex (6.20160218) UNRELEASED; urgency=medium
 
   * Update perlmagick build dependency. Closes: #789225
+  * Fix memory leak in last release, which affected commands like
+    git-annex status when a large non-annexed file is present in the work
+    tree.
 
  -- Joey Hess <id@joeyh.name>  Thu, 18 Feb 2016 13:09:21 -0400