From 5b373a9dd27ebe025809988562f001cb50b37ce8 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Wed, 23 Feb 2022 12:38:35 -0400
Subject: [PATCH] read a consistent amount from pointer file

A few places were reading the max symlink size of a pointer file,
then passing tp parseLinkTargetOrPointer. Which is fine currently, but
to support pointer files with lines of data after the pointer, enough
has to be read that parseLinkTargetOrPointer can be assured of seeing
enough of that data to know if it's correctly formatted.

Sponsored-by: Dartmouth College's Datalad project
---
 Annex/CatFile.hs         |  2 +-
 Annex/Link.hs            | 16 ++++++++--------
 CmdLine/Seek.hs          |  2 +-
 Command/FilterProcess.hs |  2 +-
 Database/Keys.hs         |  2 +-
 5 files changed, 12 insertions(+), 12 deletions(-)

diff --git a/Annex/CatFile.hs b/Annex/CatFile.hs
index 7048fe77af..35162b91a1 100644
--- a/Annex/CatFile.hs
+++ b/Annex/CatFile.hs
@@ -162,7 +162,7 @@ catKey' ref sz
 	-- Avoid catting large files, that cannot be symlinks or
 	-- pointer files, which would require buffering their
 	-- content in memory, as well as a lot of IO.
-	| sz <= maxPointerSz =
+	| sz <= fromIntegral maxPointerSz =
 		parseLinkTargetOrPointer . L.toStrict <$> catObject ref
 catKey' _ _ = return Nothing
 
diff --git a/Annex/Link.hs b/Annex/Link.hs
index 321aba23cf..2b13ac75f3 100644
--- a/Annex/Link.hs
+++ b/Annex/Link.hs
@@ -82,10 +82,10 @@ getAnnexLinkTarget' file coresymlinks = if coresymlinks
 	probesymlink = R.readSymbolicLink file
 
 	probefilecontent = withFile (fromRawFilePath file) ReadMode $ \h -> do
-		s <- S.hGet h unpaddedMaxPointerSz
+		s <- S.hGet h maxSymlinkSz
 		-- If we got the full amount, the file is too large
 		-- to be a symlink target.
-		return $ if S.length s == unpaddedMaxPointerSz
+		return $ if S.length s == maxSymlinkSz
 			then mempty
 			else 
 				-- If there are any NUL or newline
@@ -331,13 +331,13 @@ formatPointer k = prefix <> keyFile k <> nl
  - memory when reading files that may be pointers.
  -
  - 8192 bytes is plenty for a pointer to a key. This adds some additional
- - padding to allow for any pointer files that might have
- - lines after the key explaining what the file is used for. -}
-maxPointerSz :: Integer
+ - padding to allow for pointer files that have lines of additional data
+ - after the key. -}
+maxPointerSz :: Int
 maxPointerSz = 81920
 
-unpaddedMaxPointerSz :: Int
-unpaddedMaxPointerSz = 8192
+maxSymlinkSz :: Int
+maxSymlinkSz = 8192
 
 {- Checks if a worktree file is a pointer to a key.
  -
@@ -367,7 +367,7 @@ isPointerFile f = catchDefaultIO Nothing $
   where
 	checkcontentfollowssymlinks = 
 		withFile (fromRawFilePath f) ReadMode readhandle
-	readhandle h = parseLinkTargetOrPointer <$> S.hGet h unpaddedMaxPointerSz
+	readhandle h = parseLinkTargetOrPointer <$> S.hGet h maxPointerSz
 
 {- Checks a symlink target or pointer file first line to see if it
  - appears to point to annexed content.
diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs
index 599a249e43..3daaa5ad80 100644
--- a/CmdLine/Seek.hs
+++ b/CmdLine/Seek.hs
@@ -464,7 +464,7 @@ seekFilteredKeys seeker listfs = do
 
 	mdprocess mi mdreader ofeeder ocloser = liftIO mdreader >>= \case
 		Just ((si, f), Just (sha, size, _type))
-			| size < maxPointerSz -> do
+			| size < fromIntegral maxPointerSz -> do
 				feedmatches mi ofeeder si f sha
 				mdprocess mi mdreader ofeeder ocloser
 		Just _ -> mdprocess mi mdreader ofeeder ocloser
diff --git a/Command/FilterProcess.hs b/Command/FilterProcess.hs
index ba23038213..d53303c6fd 100644
--- a/Command/FilterProcess.hs
+++ b/Command/FilterProcess.hs
@@ -62,7 +62,7 @@ clean file = do
 	let conv b l = (B.concat (map pktLineToByteString l), b)
 	(b, readcomplete) <- 
 		either (conv False) (conv True)
-			<$> liftIO (readUntilFlushPktOrSize unpaddedMaxPointerSz)
+			<$> liftIO (readUntilFlushPktOrSize maxPointerSz)
 	
 	let passthrough
 		| readcomplete = liftIO $ respondFilterRequest b
diff --git a/Database/Keys.hs b/Database/Keys.hs
index 3c2541ead3..90ce7d1a45 100644
--- a/Database/Keys.hs
+++ b/Database/Keys.hs
@@ -447,7 +447,7 @@ reconcileStaged qh = unlessM (Git.Config.isBare <$> gitRepo) $ do
 	  where
 		procthread mdreader catfeeder = mdreader >>= \case
 			Just (ka, Just (sha, size, _type))
-				| size < maxPointerSz -> do
+				| size < fromIntegral maxPointerSz -> do
 					() <- catfeeder (ka, sha)
 					procthread mdreader catfeeder
 			Just _ -> procthread mdreader catfeeder
-- 
2.30.2