add back debug logging

Make Utility.Process wrap the parts of System.Process that I use,
and add debug logging to them.

Also wrote some higher-level code that allows running an action
with handles to a processes stdin or stdout (or both), and checking
its exit status, all in a single function call.

As a bonus, the debug logging now indicates whether the process
is being run to read from it, feed it data, chat with it (writing and
reading), or just call it for its side effect.

1 files changed, 16 insertions, 29 deletions

diff --git a/Utility/Gpg.hs b/Utility/Gpg.hs
index 26ac688e3..eed77805c 100644
--- a/Utility/Gpg.hs
+++ b/Utility/Gpg.hs
@@ -13,7 +13,6 @@ import Control.Applicative
 import Control.Concurrent
 import Control.Exception (bracket)
 import System.Posix.Env (setEnv, unsetEnv, getEnv)	
-import System.Process
 
 import Common
 
@@ -39,30 +38,21 @@ stdParams params = do
 readStrict :: [CommandParam] -> IO String
 readStrict params = do
 	params' <- stdParams params
-	(_, Just from, _, pid)
-		<- createProcess (proc "gpg" params')
-			{ std_out = CreatePipe }
-	hSetBinaryMode from True
-	r <- hGetContentsStrict from
-	forceSuccessProcess pid "gpg" params'
-	return r
+	withHandle StdoutHandle createProcessSuccess (proc "gpg" params') $ \h -> do
+		hSetBinaryMode h True
+		hGetContentsStrict h
 
 {- Runs gpg, piping an input value to it, and returning its stdout,
  - strictly. -}
 pipeStrict :: [CommandParam] -> String -> IO String
 pipeStrict params input = do
 	params' <- stdParams params
-	(Just to, Just from, _, pid)
-		<- createProcess (proc "gpg" params')
-			{ std_in = CreatePipe
-			, std_out = CreatePipe }
-	hSetBinaryMode to True
-	hSetBinaryMode from True
-	hPutStr to input
-	hClose to
-	r <- hGetContentsStrict from
-	forceSuccessProcess pid "gpg" params'
-	return r
+	withBothHandles createProcessSuccess (proc "gpg" params') $ \(to, from) -> do
+		hSetBinaryMode to True
+		hSetBinaryMode from True
+		hPutStr to input
+		hClose to
+		hGetContentsStrict from
 
 {- Runs gpg with some parameters, first feeding it a passphrase via
  - --passphrase-fd, then feeding it an input, and passing a handle
@@ -82,16 +72,13 @@ passphraseHandle params passphrase a b = do
 	let passphrasefd = [Param "--passphrase-fd", Param $ show pfd]
 
 	params' <- stdParams $ passphrasefd ++ params
-	(Just toh, Just fromh, _, pid) <- createProcess (proc "gpg" params')
-		{ std_in = CreatePipe, std_out = CreatePipe }
-	L.hPut toh =<< a
-	hClose toh
-	ret <- b fromh
-
-	-- cleanup
-	forceSuccessProcess pid "gpg" params'
-	closeFd frompipe
-	return ret
+	closeFd frompipe `after`
+		withBothHandles createProcessSuccess (proc "gpg" params') go
+	where
+		go (to, from) = do
+			L.hPut to =<< a
+			hClose to
+			b from
 
 {- Finds gpg public keys matching some string. (Could be an email address,
  - a key id, or a name. -}