diff options
author | Joey Hess <joeyh@joeyh.name> | 2015-04-04 14:53:17 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2015-04-04 14:54:03 -0400 |
commit | 8815f95d1ad0413ca35e6873f4b7b272bac629db (patch) | |
tree | 00701e81efc5d7725d28e8fe68754fe778312188 /Remote | |
parent | 092e6b0f3f61ad3ede912a00bbbeb635ab9bc267 (diff) |
relay external special remote stderr through progress suppression machinery (eep!)
It sounds worse than it is. ;)
Some external special remotes may run commands that display progress on
stderr. If git-annex is run with --quiet, this should filter out such
displays while letting the errors through.
Diffstat (limited to 'Remote')
-rw-r--r-- | Remote/External.hs | 41 | ||||
-rw-r--r-- | Remote/External/Types.hs | 2 |
2 files changed, 26 insertions, 17 deletions
diff --git a/Remote/External.hs b/Remote/External.hs index 39531998d..adfd79113 100644 --- a/Remote/External.hs +++ b/Remote/External.hs @@ -17,6 +17,7 @@ import qualified Git import Config import Remote.Helper.Special import Utility.Metered +import Messages.Progress import Logs.Transfer import Logs.PreferredContent.Raw import Logs.RemoteState @@ -26,6 +27,7 @@ import Annex.UUID import Creds import Control.Concurrent.STM +import Control.Concurrent.Async import System.Log.Logger (debugM) import qualified Data.Map as M @@ -323,21 +325,28 @@ fromExternal lck external extractor a = {- Starts an external remote process running, but does not handle checking - VERSION, etc. -} startExternal :: ExternalType -> Annex ExternalState -startExternal externaltype = liftIO $ do - (Just hin, Just hout, _, pid) <- createProcess $ (proc cmd []) - { std_in = CreatePipe - , std_out = CreatePipe - , std_err = Inherit - } - fileEncoding hin - fileEncoding hout - checkearlytermination =<< getProcessExitCode pid - return $ ExternalState - { externalSend = hin - , externalReceive = hout - , externalPid = pid - , externalPrepared = Unprepared - } +startExternal externaltype = do + errrelayer <- mkStderrRelayer + liftIO $ do + (Just hin, Just hout, Just herr, pid) <- createProcess $ + (proc cmd []) + { std_in = CreatePipe + , std_out = CreatePipe + , std_err = CreatePipe + } + fileEncoding hin + fileEncoding hout + fileEncoding herr + stderrelay <- async $ errrelayer herr + checkearlytermination =<< getProcessExitCode pid + return $ ExternalState + { externalSend = hin + , externalReceive = hout + , externalShutdown = do + cancel stderrelay + void $ waitForProcess pid + , externalPrepared = Unprepared + } where cmd = externalRemoteProgram externaltype @@ -357,7 +366,7 @@ stopExternal external = liftIO $ stop =<< atomically (tryReadTMVar v) void $ atomically $ tryTakeTMVar v hClose $ externalSend st hClose $ externalReceive st - void $ waitForProcess $ externalPid st + externalShutdown st v = externalState external externalRemoteProgram :: ExternalType -> String diff --git a/Remote/External/Types.hs b/Remote/External/Types.hs index c7a28a359..3c9e89d40 100644 --- a/Remote/External/Types.hs +++ b/Remote/External/Types.hs @@ -70,7 +70,7 @@ type ExternalType = String data ExternalState = ExternalState { externalSend :: Handle , externalReceive :: Handle - , externalPid :: ProcessHandle + , externalShutdown :: IO () , externalPrepared :: PrepareStatus } |