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.

2 files changed, 10 insertions, 15 deletions

diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index 9da374174..8a2c1afef 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -133,15 +133,13 @@ retrieveCheap :: BupRepo -> Key -> FilePath -> Annex Bool
 retrieveCheap _ _ _ = return False
 
 retrieveEncrypted :: BupRepo -> (Cipher, Key) -> Key -> FilePath -> Annex Bool
-retrieveEncrypted buprepo (cipher, enck) _ f = do
-	let params = bupParams "join" buprepo [Param $ bupRef enck]
-	liftIO $ catchBoolIO $ do
-		(_, Just h, _, pid)
-			<- createProcess (proc "bup" $ toCommand params)
-				{ std_out = CreatePipe }
+retrieveEncrypted buprepo (cipher, enck) _ f = liftIO $ catchBoolIO $
+	withHandle StdoutHandle createProcessSuccess p $ \h -> do
 		withDecryptedContent cipher (L.hGetContents h) $ L.writeFile f
-		forceSuccessProcess pid "bup" $ toCommand params
 		return True
+	where
+		params = bupParams "join" buprepo [Param $ bupRef enck]
+		p = proc "bup" $ toCommand params
 
 remove :: Key -> Annex Bool
 remove _ = do
diff --git a/Remote/Git.hs b/Remote/Git.hs
index a9a6d6004..3412de89b 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -9,7 +9,6 @@ module Remote.Git (remote, repoAvail) where
 
 import qualified Data.Map as M
 import Control.Exception.Extensible
-import System.Process
 
 import Common.Annex
 import Utility.CopyFile
@@ -127,13 +126,11 @@ tryGitConfigRead r
 		safely a = either (const $ return r) return
 				=<< liftIO (try a :: IO (Either SomeException Git.Repo))
 
-		pipedconfig cmd params = safely $ do
-			(_, Just h, _, pid) <-
-				createProcess (proc cmd $ toCommand params)
-					{ std_out = CreatePipe }
-			r' <- Git.Config.hRead r h
-			forceSuccessProcess pid cmd $ toCommand params
-			return r'
+		pipedconfig cmd params = safely $
+			withHandle StdoutHandle createProcessSuccess p $
+				Git.Config.hRead r
+			where
+				p = proc cmd $ toCommand params
 
 		geturlconfig headers = do
 			s <- Url.get (Git.repoLocation r ++ "/config") headers