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.
This commit is contained in:
parent
549f861999
commit
1db7d27a45
17 changed files with 251 additions and 126 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue