convert to withCreateProcess for async exception safety

Not yet 100% done, so far I've grepped for waitForProcess and converted
everything that uses that to start the process with withCreateProcess.

Except for some things like P2P.IO and Assistant.TransferrerPool,
and Utility.CoProcess, that manage a pool of processes. See #2
in https://git-annex.branchable.com/todo/more_extensive_retries_to_mask_transient_failures/#comment-209f8a8c38e63fb3a704e1282cb269c7
for how those will need to be dealt with.

checkSuccessProcess, ignoreFailureProcess, and forceSuccessProcess calls waitForProcess, so
callers of them will also need to be dealt with, and have not been yet.
This commit is contained in:
Joey Hess 2020-06-03 15:48:09 -04:00
parent 1ee5919d1e
commit 92f775eba0
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
9 changed files with 68 additions and 65 deletions

View file

@ -50,19 +50,22 @@ data HistoryCommit = HistoryCommit
{- Gets a History starting with the provided commit, and down to the
- requested depth. -}
getHistoryToDepth :: Integer -> Ref -> Repo -> IO (Maybe (History HistoryCommit))
getHistoryToDepth n commit r = do
(_, Just inh, _, pid) <- createProcess (gitCreateProcess params r)
{ std_out = CreatePipe }
!h <- fmap (truncateHistoryToDepth n)
. build Nothing
. map parsehistorycommit
. map L.toStrict
. L8.lines
<$> L.hGetContents inh
hClose inh
void $ waitForProcess pid
return h
getHistoryToDepth n commit r = withCreateProcess p go
where
p = (gitCreateProcess params r)
{ std_out = CreatePipe }
go _ (Just inh) _ pid = do
!h <- fmap (truncateHistoryToDepth n)
. build Nothing
. map parsehistorycommit
. map L.toStrict
. L8.lines
<$> L.hGetContents inh
hClose inh
void $ waitForProcess pid
return h
go _ _ _ _ = error "internal"
build h [] = fmap (mapHistory fst) h
build _ (Nothing:_) = Nothing
build Nothing (Just v:rest) =