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)

Remote/Bup.hs

@@ -164,10 +164,16 @@ store r buprepo = byteStorer $ \k b p -> do
 retrieve :: BupRepo -> Retriever
 retrieve buprepo = byteRetriever $ \k sink -> do
 	let params = bupParams "join" buprepo [Param $ bupRef k]
-	let p = proc "bup" (toCommand params)
-	(_, Just h, _, pid) <- liftIO $ createProcess $ p { std_out = CreatePipe }
-	liftIO (hClose h >> forceSuccessProcess p pid)
-		`after` (sink =<< liftIO (L.hGetContents h))
+	let p = (proc "bup" (toCommand params))
+		{ std_out = CreatePipe }
+	bracketIO (createProcess p) cleanupProcess (go sink p)
+  where
+	go sink p (_, Just h, _, pid) = do
+		() <- sink =<< liftIO (L.hGetContents h)
+		liftIO $ do
+			hClose h
+			forceSuccessProcess p pid
+	go _ _ _ = error "internal"
 
 {- Cannot revert having stored a key in bup, but at least the data for the
  - key will be used for deltaing data of other keys stored later.

Remote/Ddar.hs

@@ -157,10 +157,16 @@ ddarExtractRemoteCall cs ddarrepo k =
 retrieve :: DdarRepo -> Retriever
 retrieve ddarrepo = byteRetriever $ \k sink -> do
 	(cmd, params) <- ddarExtractRemoteCall NoConsumeStdin ddarrepo k
-	let p = (proc cmd $ toCommand params) { std_out = CreatePipe }
-	(_, Just h, _, pid) <- liftIO $ createProcess p
-	liftIO (hClose h >> forceSuccessProcess p pid)
-		`after` (sink =<< liftIO (L.hGetContents h))
+	let p = (proc cmd $ toCommand params)
+		{ std_out = CreatePipe }
+	bracketIO (createProcess p) cleanupProcess (go sink p)
+  where
+	go sink p (_, Just h, _, pid) = do
+		() <- sink =<< liftIO (L.hGetContents h)
+		liftIO $ do
+			hClose h
+			forceSuccessProcess p pid
+	go _ _ _ = error "internal"
 
 remove :: DdarRepo -> Remover
 remove ddarrepo key = do

Remote/Glacier.hs

@@ -185,14 +185,15 @@ retrieve' r k sink = go =<< glacierEnv c gc u
 		]
 	go Nothing = giveup "cannot retrieve from glacier"
 	go (Just environ) = do
-		let cmd = (proc "glacier" (toCommand params))
+		let p = (proc "glacier" (toCommand params))
 			{ env = Just environ
 			, std_out = CreatePipe
 			}
-		(_, Just h, _, pid) <- liftIO $ createProcess cmd
+		bracketIO (createProcess p) cleanupProcess (go' p)
+	go' p (_, Just h, _, pid) = do
 		let cleanup = liftIO $ do
 			hClose h
-			forceSuccessProcess cmd pid
+			forceSuccessProcess p pid
 		flip finally cleanup $ do
 			-- Glacier cannot store empty files, so if
 			-- the output is empty, the content is not
@@ -200,6 +201,7 @@ retrieve' r k sink = go =<< glacierEnv c gc u
 			whenM (liftIO $ hIsEOF h) $
 				giveup "Content is not available from glacier yet. Recommend you wait up to 4 hours, and then run this command again."
 			sink =<< liftIO (L.hGetContents h)
+	go' _ _ = error "internal"
 
 remove :: Remote -> Remover
 remove r k = unlessM go $