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:
parent
2dc7b5186a
commit
438dbe3b66
13 changed files with 125 additions and 87 deletions
44
Git/Fsck.hs
44
Git/Fsck.hs
|
@ -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
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue