remotedaemon: avoid extraneous stdout output

This commit is contained in:
Joey Hess 2014-04-08 14:02:25 -04:00
parent 9a4a3bfb43
commit cbcb7f50d8
3 changed files with 24 additions and 23 deletions

View file

@ -16,8 +16,7 @@ import Logs.Location
import Annex.Transfer
import qualified Remote
import Types.Key
import GHC.IO.Handle
import Utility.SimpleProtocol (ioHandles)
data TransferRequest = TransferRequest Direction Remote Key AssociatedFile
@ -29,7 +28,8 @@ seek :: CommandSeek
seek = withNothing start
start :: CommandStart
start = withHandles $ \(readh, writeh) -> do
start = do
(readh, writeh) <- liftIO ioHandles
runRequests readh writeh runner
stop
where
@ -44,21 +44,6 @@ start = withHandles $ \(readh, writeh) -> do
download (Remote.uuid remote) key file forwardRetry $ \p ->
getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p
{- stdin and stdout are connected with the caller, to be used for
- communication with it. But doing a transfer might involve something
- that tries to read from stdin, or write to stdout. To avoid that, close
- stdin, and duplicate stderr to stdout. Return two new handles
- that are duplicates of the original (stdin, stdout). -}
withHandles :: ((Handle, Handle) -> Annex a) -> Annex a
withHandles a = do
readh <- liftIO $ hDuplicate stdin
writeh <- liftIO $ hDuplicate stdout
liftIO $ do
nullh <- openFile devNull ReadMode
nullh `hDuplicateTo` stdin
stderr `hDuplicateTo` stdout
a (readh, writeh)
runRequests
:: Handle
-> Handle

View file

@ -26,18 +26,19 @@ import qualified Data.Map as M
runForeground :: IO ()
runForeground = do
(readh, writeh) <- ioHandles
ichan <- newChan :: IO (Chan Consumed)
ochan <- newChan :: IO (Chan Emitted)
let reader = forever $ do
l <- getLine
l <- hGetLine readh
case parseMessage l of
Nothing -> error $ "protocol error: " ++ l
Just cmd -> writeChan ichan cmd
let writer = forever $ do
msg <- readChan ochan
putStrLn $ unwords $ formatMessage msg
hFlush stdout
hPutStrLn writeh $ unwords $ formatMessage msg
hFlush writeh
let controller = runController ichan ochan
-- If any thread fails, the rest will be killed.

View file

@ -16,12 +16,13 @@ module Utility.SimpleProtocol (
parse1,
parse2,
parse3,
ioHandles,
) where
import Control.Applicative
import Data.Char
import GHC.IO.Handle
import Utility.Misc
import Common
-- Messages that can be sent.
class Sendable m where
@ -73,3 +74,17 @@ parse3 mk s = mk <$> deserialize p1 <*> deserialize p2 <*> deserialize p3
splitWord :: String -> (String, String)
splitWord = separate isSpace
{- When a program speaks a simple protocol over stdio, any other output
- to stdout (or anything that attempts to read from stdin)
- will mess up the protocol. To avoid that, close stdin, and
- and duplicate stderr to stdout. Return two new handles
- that are duplicates of the original (stdin, stdout). -}
ioHandles :: IO (Handle, Handle)
ioHandles = do
readh <- hDuplicate stdin
writeh <- hDuplicate stdout
nullh <- openFile devNull ReadMode
nullh `hDuplicateTo` stdin
stderr `hDuplicateTo` stdout
return (readh, writeh)