convert to withCreateProcess for async exception safety

This handles all createProcessSuccess callers, and aside from process
pools, the complete conversion of all process running to async exception
safety should be complete now.

Also, was able to remove from Utility.Process the old API that I now
know was not a good idea. And proof it was bad: The code size went *down*,
despite there being a fair bit of boilerplate for some future API to
reduce.
This commit is contained in:
Joey Hess 2020-06-04 15:36:34 -04:00
parent 12e7d52c8b
commit 2670890b17
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
16 changed files with 196 additions and 191 deletions

View file

@ -834,7 +834,7 @@ commitOnCleanup repo r st a = go `after` a
| not $ Git.repoIsUrl repo = onLocalFast st $
doQuietSideAction $
Annex.Branch.commit =<< Annex.Branch.commitMessage
| otherwise = void $ do
| otherwise = do
Just (shellcmd, shellparams) <-
Ssh.git_annex_shell NoConsumeStdin
repo "commit" [] []
@ -842,10 +842,13 @@ commitOnCleanup repo r st a = go `after` a
-- Throw away stderr, since the remote may not
-- have a new enough git-annex shell to
-- support committing.
liftIO $ catchMaybeIO $
withQuietOutput createProcessSuccess $
proc shellcmd $
toCommand shellparams
liftIO $ void $ catchMaybeIO $ withNullHandle $ \nullh ->
let p = (proc shellcmd (toCommand shellparams))
{ std_out = UseHandle nullh
, std_err = UseHandle nullh
}
in withCreateProcess p $ \_ _ _ ->
forceSuccessProcess p
wantHardLink :: Annex Bool
wantHardLink = (annexHardLink <$> Annex.getGitConfig)