From ca454c47f2410164819a0c08914989d530094df7 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Fri, 25 Sep 2020 10:58:30 -0400
Subject: [PATCH] explicitly wait for a git process

Eliminate a zombie that was only cleaned up by the later zombie cleanup
code.

This is still not ideal, it would be cleaner if it used conduit or
something, and if the thread gets killed before waiting, it won't stop
the process.

Only remaining zombies are in CmdLine.Seek
---
 Annex/Branch.hs  | 19 +++++++++++--------
 Command/Info.hs  |  5 +++--
 Git/Command.hs   |  6 ------
 Logs/Location.hs | 17 +++++++++++------
 4 files changed, 25 insertions(+), 22 deletions(-)

diff --git a/Annex/Branch.hs b/Annex/Branch.hs
index ee0fccc849..072fd44b9e 100644
--- a/Annex/Branch.hs
+++ b/Annex/Branch.hs
@@ -393,24 +393,26 @@ commitIndex' jl branchref message basemessage retrynum parents = do
 
 {- Lists all files on the branch. including ones in the journal
  - that have not been committed yet. There may be duplicates in the list. -}
-files :: Annex [RawFilePath]
+files :: Annex ([RawFilePath], IO Bool)
 files = do
 	_  <- update
+	(bfs, cleanup) <- branchFiles
 	-- ++ forces the content of the first list to be buffered in memory,
 	-- so use getJournalledFilesStale which should be much smaller most
 	-- of the time. branchFiles will stream as the list is consumed.
-	(++)
+	l <- (++)
 		<$> (map toRawFilePath <$> getJournalledFilesStale)
-		<*> branchFiles
+		<*> pure bfs
+	return (l, cleanup)
 
 {- Files in the branch, not including any from journalled changes,
  - and without updating the branch. -}
-branchFiles :: Annex [RawFilePath]
+branchFiles :: Annex ([RawFilePath], IO Bool)
 branchFiles = withIndex $ inRepo branchFiles'
 
-branchFiles' :: Git.Repo -> IO [RawFilePath]
-branchFiles' = Git.Command.pipeNullSplitZombie'
-	(lsTreeParams Git.LsTree.LsTreeRecursive fullname [Param "--name-only"])
+branchFiles' :: Git.Repo -> IO ([RawFilePath], IO Bool)
+branchFiles' = Git.Command.pipeNullSplit' $
+	lsTreeParams Git.LsTree.LsTreeRecursive fullname [Param "--name-only"]
 
 {- Populates the branch's index file with the current branch contents.
  - 
@@ -620,10 +622,11 @@ performTransitionsLocked jl ts neednewlocalbranch transitionedrefs = do
 		remoteconfigmap <- calcRemoteConfigMap <$> getStaged remoteLog
 		-- partially apply, improves performance
 		let changers' = map (\c -> c config trustmap remoteconfigmap) changers
-		fs <- branchFiles
+		(fs, cleanup) <- branchFiles
 		forM_ fs $ \f -> do
 			content <- getStaged f
 			apply changers' f content
+		liftIO $ void cleanup
 	apply [] _ _ = return ()
 	apply (changer:rest) file content = case changer file content of
 		PreserveFile -> apply rest file content
diff --git a/Command/Info.hs b/Command/Info.hs
index 2b7e3e7375..a2f9f369cb 100644
--- a/Command/Info.hs
+++ b/Command/Info.hs
@@ -532,8 +532,9 @@ cachedRemoteData u = do
 			let combinedata d uk = finishCheck uk >>= \case
 				Nothing -> return d
 				Just k -> return $ addKey k d
-			v <- lift $ foldM combinedata emptyKeyInfo
-				=<< loggedKeysFor' u
+			(ks, cleanup) <- lift $ loggedKeysFor' u
+			v <- lift $ foldM combinedata emptyKeyInfo ks
+			liftIO $ void cleanup
 			put s { repoData = M.insert u v (repoData s) }
 			return v
 
diff --git a/Git/Command.hs b/Git/Command.hs
index b9a7399aa2..c20aed8c96 100644
--- a/Git/Command.hs
+++ b/Git/Command.hs
@@ -134,12 +134,6 @@ pipeNullSplitStrict params repo = do
 	s <- pipeReadStrict params repo
 	return $ filter (not . S.null) $ S.split 0 s
 
-pipeNullSplitZombie :: [CommandParam] -> Repo -> IO [L.ByteString]
-pipeNullSplitZombie params repo = leaveZombie <$> pipeNullSplit params repo
-
-pipeNullSplitZombie' :: [CommandParam] -> Repo -> IO [S.ByteString]
-pipeNullSplitZombie' params repo = leaveZombie <$> pipeNullSplit' params repo
-
 {- Doesn't run the cleanup action. A zombie results. -}
 leaveZombie :: (a, IO Bool) -> a
 leaveZombie = fst
diff --git a/Logs/Location.hs b/Logs/Location.hs
index 2c3439805f..560fbeec23 100644
--- a/Logs/Location.hs
+++ b/Logs/Location.hs
@@ -126,14 +126,15 @@ finishCheck (Unchecked a) = a
  -
  - Keys that have been marked as dead are not included.
  -}
-loggedKeys :: Annex [Unchecked Key]
+loggedKeys :: Annex ([Unchecked Key], IO Bool)
 loggedKeys = loggedKeys' (not <$$> checkDead)
 
-loggedKeys' :: (Key -> Annex Bool) -> Annex [Unchecked Key]
+loggedKeys' :: (Key -> Annex Bool) -> Annex ([Unchecked Key], IO Bool)
 loggedKeys' check = do
 	config <- Annex.getGitConfig
-	mapMaybe (defercheck <$$> locationLogFileKey config)
-		<$> Annex.Branch.files
+	(bfs, cleanup) <- Annex.Branch.files
+	let l = mapMaybe (defercheck <$$> locationLogFileKey config) bfs
+	return (l, cleanup)
   where
 	defercheck k = Unchecked $ ifM (check k)
 		( return (Just k)
@@ -146,9 +147,13 @@ loggedKeys' check = do
  - This does not stream well; use loggedKeysFor' for lazy streaming.
  -}
 loggedKeysFor :: UUID -> Annex [Key]
-loggedKeysFor u = catMaybes <$> (mapM finishCheck =<< loggedKeysFor' u)
+loggedKeysFor u = do
+	(l, cleanup) <- loggedKeysFor' u
+	l' <- catMaybes <$> mapM finishCheck l
+	liftIO $ void cleanup
+	return l'
 
-loggedKeysFor' :: UUID -> Annex [Unchecked Key]
+loggedKeysFor' :: UUID -> Annex ([Unchecked Key], IO Bool)
 loggedKeysFor' u = loggedKeys' isthere
   where
 	isthere k = do
-- 
2.39.5