diff options
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 } |