async exception safety

Use async/cancel so helper threads are not left running.

Bracket createPipe to ensure the handles get closed.

Utility/Gpg.hs

@@ -47,7 +47,7 @@ import Utility.Tmp
 #endif
 import Utility.Format (decode_c)
 
-import Control.Concurrent
+import Control.Concurrent.Async
 import Control.Monad.IO.Class
 import qualified Data.Map as M
 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 cmd params passphrase feeder reader = do
 #ifndef mingw32_HOST_OS
+	let setup = liftIO $ do
 		-- pipe the passphrase into gpg on a fd
-	(frompipe, topipe) <- liftIO System.Posix.IO.createPipe
-	liftIO $ void $ forkIO $ do
+		(frompipe, topipe) <- System.Posix.IO.createPipe
 		toh <- fdToHandle topipe
+		t <- async $ do
 			hPutStrLn toh passphrase
 			hClose toh
 		let Fd pfd = frompipe
 		let passphrasefd = [Param "--passphrase-fd", Param $ show pfd]
-	liftIO (closeFd frompipe) `after` go (passphrasefd ++ params)
+		return (passphrasefd, frompipe, toh, t)
+	let cleanup (_, frompipe, toh, t) = liftIO $ do
+		closeFd frompipe
+		hClose toh
+		cancel t
+	bracket setup cleanup $ \(passphrasefd, _, _, _) -> 
+		go (passphrasefd ++ params)
 #else
 	-- store the passphrase in a temp file for gpg
 	withTmpFile "gpg" $ \tmpfile h -> do
@@ -188,10 +195,11 @@ pipeLazy (GpgCmd cmd) params feeder reader = do
 	setup = liftIO . createProcess
 	cleanup = liftIO . cleanupProcess
 
-	go p (Just to, Just from, _, pid) = do
-		liftIO $ void $ forkIO $ do
+	go p (Just to, Just from, _, pid) =
+		let runfeeder = do
 			feeder to
 			hClose to
+		in bracketIO (async runfeeder) cancel $ const $ do
 			r <- reader from
 			liftIO $ forceSuccessProcess p pid
 			return r