convert to withCreateProcess for async exception safety

This handles all sites where checkSuccessProcess/ignoreFailureProcess
is used, except for one: Git.Command.pipeReadLazy
That one will be significantly more work to convert to bracketing.

(Also skipped Command.Assistant.autoStart, but it does not need to
shut down the processes it started on exception because they are
git-annex assistant daemons..)

forceSuccessProcess is done, except for createProcessSuccess.
All call sites of createProcessSuccess will need to be converted
to bracketing.

(process pools still todo also)
This commit is contained in:
Joey Hess 2020-06-04 12:13:26 -04:00
parent 2dc7b5186a
commit 438dbe3b66
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
13 changed files with 125 additions and 87 deletions

View file

@ -77,27 +77,31 @@ findBroken batchmode r = do
then toBatchCommand (command, params)
else return (command, params)
p@(_, _, _, pid) <- createProcess $
(proc command' (toCommand params'))
{ std_out = CreatePipe
, std_err = CreatePipe
}
(o1, o2) <- concurrently
(parseFsckOutput maxobjs r (stdoutHandle p))
(parseFsckOutput maxobjs r (stderrHandle p))
fsckok <- checkSuccessProcess pid
case mappend o1 o2 of
FsckOutput badobjs truncated
| S.null badobjs && not fsckok -> return FsckFailed
| otherwise -> return $ FsckFoundMissing badobjs truncated
NoFsckOutput
| not fsckok -> return FsckFailed
| otherwise -> return noproblem
-- If all fsck output was duplicateEntries warnings,
-- the repository is not broken, it just has some unusual
-- tree objects in it. So ignore nonzero exit status.
AllDuplicateEntriesWarning -> return noproblem
let p = (proc command' (toCommand params'))
{ std_out = CreatePipe
, std_err = CreatePipe
}
withCreateProcess p go
where
go _ (Just outh) (Just errh) pid = do
(o1, o2) <- concurrently
(parseFsckOutput maxobjs r outh)
(parseFsckOutput maxobjs r errh)
fsckok <- checkSuccessProcess pid
case mappend o1 o2 of
FsckOutput badobjs truncated
| S.null badobjs && not fsckok -> return FsckFailed
| otherwise -> return $ FsckFoundMissing badobjs truncated
NoFsckOutput
| not fsckok -> return FsckFailed
| otherwise -> return noproblem
-- If all fsck output was duplicateEntries warnings,
-- the repository is not broken, it just has some
-- unusual tree objects in it. So ignore nonzero
-- exit status.
AllDuplicateEntriesWarning -> return noproblem
go _ _ _ _ = error "internal"
maxobjs = 10000
noproblem = FsckFoundMissing S.empty False