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
This commit is contained in:
Joey Hess 2020-09-25 10:58:30 -04:00
parent b5b1aeacba
commit ca454c47f2
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
4 changed files with 25 additions and 22 deletions

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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