async exception safety
Use async/cancel so helper threads are not left running. Bracket createPipe to ensure the handles get closed.
This commit is contained in:
parent
a0d09f1d9e
commit
074260f036
1 changed files with 21 additions and 13 deletions
|
@ -47,7 +47,7 @@ import Utility.Tmp
|
||||||
#endif
|
#endif
|
||||||
import Utility.Format (decode_c)
|
import Utility.Format (decode_c)
|
||||||
|
|
||||||
import Control.Concurrent
|
import Control.Concurrent.Async
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Char
|
import Data.Char
|
||||||
|
@ -154,15 +154,22 @@ pipeStrict (GpgCmd cmd) params input = do
|
||||||
feedRead :: (MonadIO m, MonadMask m) => GpgCmd -> [CommandParam] -> String -> (Handle -> IO ()) -> (Handle -> m a) -> m a
|
feedRead :: (MonadIO m, MonadMask m) => GpgCmd -> [CommandParam] -> String -> (Handle -> IO ()) -> (Handle -> m a) -> m a
|
||||||
feedRead cmd params passphrase feeder reader = do
|
feedRead cmd params passphrase feeder reader = do
|
||||||
#ifndef mingw32_HOST_OS
|
#ifndef mingw32_HOST_OS
|
||||||
-- pipe the passphrase into gpg on a fd
|
let setup = liftIO $ do
|
||||||
(frompipe, topipe) <- liftIO System.Posix.IO.createPipe
|
-- pipe the passphrase into gpg on a fd
|
||||||
liftIO $ void $ forkIO $ do
|
(frompipe, topipe) <- System.Posix.IO.createPipe
|
||||||
toh <- fdToHandle topipe
|
toh <- fdToHandle topipe
|
||||||
hPutStrLn toh passphrase
|
t <- async $ do
|
||||||
|
hPutStrLn toh passphrase
|
||||||
|
hClose toh
|
||||||
|
let Fd pfd = frompipe
|
||||||
|
let passphrasefd = [Param "--passphrase-fd", Param $ show pfd]
|
||||||
|
return (passphrasefd, frompipe, toh, t)
|
||||||
|
let cleanup (_, frompipe, toh, t) = liftIO $ do
|
||||||
|
closeFd frompipe
|
||||||
hClose toh
|
hClose toh
|
||||||
let Fd pfd = frompipe
|
cancel t
|
||||||
let passphrasefd = [Param "--passphrase-fd", Param $ show pfd]
|
bracket setup cleanup $ \(passphrasefd, _, _, _) ->
|
||||||
liftIO (closeFd frompipe) `after` go (passphrasefd ++ params)
|
go (passphrasefd ++ params)
|
||||||
#else
|
#else
|
||||||
-- store the passphrase in a temp file for gpg
|
-- store the passphrase in a temp file for gpg
|
||||||
withTmpFile "gpg" $ \tmpfile h -> do
|
withTmpFile "gpg" $ \tmpfile h -> do
|
||||||
|
@ -188,13 +195,14 @@ pipeLazy (GpgCmd cmd) params feeder reader = do
|
||||||
setup = liftIO . createProcess
|
setup = liftIO . createProcess
|
||||||
cleanup = liftIO . cleanupProcess
|
cleanup = liftIO . cleanupProcess
|
||||||
|
|
||||||
go p (Just to, Just from, _, pid) = do
|
go p (Just to, Just from, _, pid) =
|
||||||
liftIO $ void $ forkIO $ do
|
let runfeeder = do
|
||||||
feeder to
|
feeder to
|
||||||
hClose to
|
hClose to
|
||||||
r <- reader from
|
in bracketIO (async runfeeder) cancel $ const $ do
|
||||||
liftIO $ forceSuccessProcess p pid
|
r <- reader from
|
||||||
return r
|
liftIO $ forceSuccessProcess p pid
|
||||||
|
return r
|
||||||
go _ _ = error "internal"
|
go _ _ = error "internal"
|
||||||
|
|
||||||
{- Finds gpg public keys matching some string. (Could be an email address,
|
{- Finds gpg public keys matching some string. (Could be an email address,
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue