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:
parent
12e7d52c8b
commit
2670890b17
16 changed files with 196 additions and 191 deletions
|
@ -1,11 +1,13 @@
|
|||
{- Using ddar as a remote. Based on bup and rsync remotes.
|
||||
-
|
||||
- Copyright 2011 Joey Hess <id@joeyh.name>
|
||||
- Copyright 2011-2020 Joey Hess <id@joeyh.name>
|
||||
- Copyright 2014 Robie Basak <robie@justgohome.co.uk>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
|
||||
module Remote.Ddar (remote) where
|
||||
|
||||
import qualified Data.Map as M
|
||||
|
@ -201,12 +203,18 @@ ddarDirectoryExists ddarrepo
|
|||
inDdarManifest :: DdarRepo -> Key -> Annex (Either String Bool)
|
||||
inDdarManifest ddarrepo k = do
|
||||
(cmd, params) <- ddarRemoteCall NoConsumeStdin ddarrepo 't' []
|
||||
let p = proc cmd $ toCommand params
|
||||
liftIO $ catchMsgIO $ withHandle StdoutHandle createProcessSuccess p $ \h -> do
|
||||
contents <- hGetContents h
|
||||
return $ elem k' $ lines contents
|
||||
let p = (proc cmd $ toCommand params)
|
||||
{ std_out = CreatePipe }
|
||||
liftIO $ catchMsgIO $ withCreateProcess p (go p)
|
||||
where
|
||||
k' = serializeKey k
|
||||
|
||||
go p _ (Just hout) _ pid = do
|
||||
contents <- hGetContents hout
|
||||
let !r = elem k' (lines contents)
|
||||
forceSuccessProcess p pid
|
||||
return r
|
||||
go _ _ _ _ _ = error "internal"
|
||||
|
||||
checkKey :: DdarRepo -> CheckPresent
|
||||
checkKey ddarrepo key = do
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue